|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 7766 (0x1e56)
Notes: pts_type(SC)
Names: »SPCHK.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/SPCHK.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/SPCHK.SC«
IDENT SPCHK 830110 NJ DDUM KMD08 PDIV ENTRY SPCHK1 ENTRY SPCHK2 ENTRY SPCHK3 ENTRY SPCHK4 ENTRY SPCHK5 ENTRY SPCHK6 ENTRY SPCHK7 ENTRY SPTCHK EXT CHDATO EXT XCOP EXT YYMMDD EXT PACKCL EXT CRKJ EXT KKCH EXT KTPLAN INCLUDE EQUATE STANDARD CHECKS * SPCHK1 PROC ******************** * * SPCHK1 - CDVCHECK * * PERFORMS CHECKDIGIT CHECK ON VALUE IN SPINPUT * IF ERROR, ERRORCODE 6 IS MOVED TO SPBINW4 * ******************** MOVE SPBINW3,CBIN1 INITIAL ERRORCODE MOVE GSWBIN1,SPBINW1 GET LENGTH CBL GSWBIN1,=W'3',CHK1RET FOR LENGTH < 3, NO CHECK CBL GSWBIN1,=W'7',CHK1ER IF 2<LENGTH<7, ERROR CBE GSWBIN1,=W'7',CHK10 IF LENGTH = 7, OK (CIRNR) CBNE GSWBIN1,=W'10',CHK1ER IF LENGTH = 10, OK (CPRNR) CHK10 MOVE GSWBIN2,=W'13' MOVE GSWBCD5,=D'0' MOVE GSWBCD6,SPINPUT GET ITEM TO BE CHECKED TBT GTADMFLG,CHK11 CBE GSWBCD6,=D'0',CHK1ER CHK11 MOVE GSWBCD3,=D'1' BLANK GSWBCD3 COPY GSWBCD3,CBIN5,CBIN1,GSWBCD6,GSWBIN2 GET NEXT DIGIT MUL GSWBCD3,WEIGTH1(GSWBIN2) MULTIPLY WITH WEIGTH ADD GSWBCD5,GSWBCD3 ADD TO OLD SUM SUB GSWBIN2,=W'1' ADJUST WEIGHT INDEX SUB GSWBIN1,=W'1' ADJUST LENGTH OF ITEM CBNE GSWBIN1,=W'0',CHK11 BACK TO NEXT DIGIT MOVE GSWBCD4,GSWBCD5 DIV GSWBCD5,=D'11' DIVIDE BY 11 MUL GSWBCD5,=D'11' MULTIPLY WITH 11 SUB GSWBCD4,GSWBCD5 GET REMAINDER MOD 11 CBE GSWBCD4,=D'0',CHK1RET IF REMAINDER 0, THEN RETURN * CHK1ER MOVE SPBINW4,=W'6' MOVE SPBINW3,CBIN3 SET ERROR VALUE * CHK1RET RET PEND EJECT SPCHK2 PROC ******************** * * SPCHK2 - CHECK DATE * * CHECKS 0<DAY<32 AND 0<MONTH<13 * DATE IS IN THE FORM DDMMYY * INPUT FIELD: SPINPUT * * IF ERROR, ERRORCODE 7 IS MOVED TO SPBINW4 * ******************** MOVE SPBINW3,CBIN1 INITIAL ERRORCODE MOVE GSWBCD3,=D'1' BLANK GSWBCD3 MOVE GSWBCD6,SPINPUT GET DATE MOVE GSWBIN2,=W'10' SET POINTER TO MONTH COPY GSWBCD3,CBIN4,CBIN2,GSWBCD6,GSWBIN2 GET MONTH CBG GSWBCD3,=D'12',CH29 CHECK MONTH CBL GSWBCD3,=D'1',CH29 SUB GSWBIN2,=W'2' ADJUST POINTER TO DAY COPY GSWBCD3,CBIN4,CBIN2,GSWBCD6,GSWBIN2 GET DAY CBG GSWBCD3,=D'31',CH29 CBL GSWBCD3,=D'1',CH29 B CH2RET CH29 MOVE SPBINW3,CBIN3 INDICATE ERROR MOVE SPBINW4,=W'7' SET ERRORCODE CH2RET MOVE GSWBCD3,=X'FF' RET PEND EJECT SPCHK3 PROC **************** * * SPCHK3 - CHECK MONTH * * CHECKS 0<MONTH<13 * MONTH IS IN THE FORM MM * INPUT FIELD: SPINPUT * * IF ERROR, ERRORCODE 7 IS MOVED TO SPBINW4 * ****************** MOVE GSWBCD3,SPINPUT GET MONTH CBG GSWBCD3,=D'12',CH39 CHECK MONTH CBL GSWBCD3,=D'1',CH39 MOVE SPBINW3,CBIN1 SET ERRORCODE OK B CH3RET CH39 MOVE SPBINW3,CBIN3 INDICATE ERROR MOVE SPBINW4,=W'7' SET ERRORCODE CH3RET RET PEND EJECT SPCHK4 PROC ******************** * * SPCHK4 - CHANGE SIGN ON VALUE, IF KREDIT KEY * ******************** MOVE SPBINW3,CBIN1 CBNE SPBINW2,=W'18',CH4RET MOVE GSWBCD7,SPINPUT IF KREDIT KEY MUL GSWBCD7,=D'-1' MOVE SPINPUT,GSWBCD7 MOVE SPBINW2,=W'3' SIMULATE EOI-KEY CH4RET RET PEND EJECT SPCHK5 PROC ******************** * * SPCHK5 - CHECK LINE NUMBER * ******************* MOVE SPBINW3,CBIN1 MOVE GSWBCD3,SPINPUT GET LINE NUMBER CBG GSWBCD3,=D'96',CH510 SPECIAL FUNCTIONS ? CBE GSWBCD3,=D'91',CH510 MUL GSWBCD3,=D'2' MOVE GSWBCD4,CVOUTOP GET NO OF LINES/PAGE SUB GSWBCD4,GSWBCD3 CBL GSWBCD4,=D'0',CH5ERR LINE NEGATIVE? MOVE GSWBIN1,GSWBCD4 CBG GSWBIN1,CMAXLIN,CH5ERR CBL GSWBIN1,CMINLIN,CH5ERR RET CH5ERR MOVE SPBINW3,CBIN3 MOVE SPBINW4,=W'8' RET CH510 MOVE GSWBIN1,GSWBCD3 RET PEND EJECT SPCHK6 PROC ******************** * * SPCHK6 - CHECK THE SPCHK6 - CHECKDIGIT IN LINE NO, * KONTOKORT * ******************* PERF KKCH MOVE GSWBCD3,SPINPUT GET DIGIT MOVE SPBINW3,CBIN1 CBE GSWBCD3,=D'0',CH6RET NO CHECK IF ZERO CBE GSWBCD3,TTKTCHK,CH6RET OK MOVE SPBINW3,CBIN3 ERROR MOVE SPBINW4,=W'13' CH6RET RET PEND EJECT SPCHK7 PROC RET PEND EJECT SPTCHK PROC ******************** * * SPTCHK - CONDITIONAL TABULATION * CONTROLLED BY 'CTAB' IN FORMATS * ******************** GETCTL 0,SPBINW3 GET APPL-VALUE CBE SPBINW3,=W'84',TCHK84 SUB SPBINW3,=W'16' ADJUST INDEX IB SPBINW3, C TCHK17,TCHK18,TCHK19,TCHK20 SUB SPBINW3,=W'61' +16-77 IB SPBINW3,TCHK78,TCHK79 TCHK00 CORRECT FIELD MOVE SPBINW3,CBIN0 RET * TCHK17 TBT BCPR,TCHK00 B TCHK99 * TCHK18 TCHK19 TCHK20 TBF BCPR,TCHK00 B TCHK99 * TCHK78 MOVE SPBINW3,TTCNTNR SUB SPBINW3,=W'100' CBG SPBINW3,CTR12(GTUWB,CBIN2),TCHK00 CONTINUE TAB B TCHK99 CORRECT FIELD * TCHK79 MOVE SPBINW3,TTCNTNR SUB SPBINW3,=W'100' CBG SPBINW3,CTR12(GTUWB,CBIN2),TCHK99 CORRECT FIELD B TCHK00 CONTINUE TAB * TCHK84 TBF GTTRSEL,TCHK00 B TCHK99 * TCHK99 CONTINUE TAB MOVE SPBINW3,CBIN2 RET PEND END