|
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: 30154 (0x75ca)
Notes: pts_type(SC)
Names: »SUBAPL.SC«
└─⟦9ad21746d⟧ Bits:30009682 Philips computer tape "600304"
└─⟦this⟧ »NJ-AMT/SUBAPL.SC«
IDENT SUBAPL 02.01.XXX.1
DDUM KMD08
PDIV
ENTRY SPAPPL
ENTRY SPCHK1
ENTRY SPCHK2
ENTRY SPCHK3
ENTRY SPCHK4
ENTRY SPCHK5
ENTRY SPCHK6
ENTRY SPCHK7
ENTRY SPTCHK
ENTRY SETKRE
ENTRY SETDEB
ENTRY CLRSW
ENTRY SELTR
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(TTASKNR,CBIN2),TCHK00 CONTINUE TAB
B TCHK99 CORRECT FIELD
*
TCHK79
MOVE SPBINW3,TTCNTNR
SUB SPBINW3,=W'100'
CBG SPBINW3,CTR12(TTASKNR,CBIN2),TCHK99 CORRECT FIELD
B TCHK00 CONTINUE TAB
*
TCHK84
TBF GTTRSEL,TCHK00
B TCHK99
*
TCHK99 CONTINUE TAB
MOVE SPBINW3,CBIN2
RET
PEND
EJECT
SPAPPL PROC
********************
*
* SPAPPL - PROCEDURE ACTIVATED BY SCREEN PACKAGE IF APPL-VALUE
* IS NOT ZERO, WHICH IS THE CASE FOR ALL FIELDS.
*
* APPL-VALUE IS EQUAL TO FIELD-NAME (KMD FELT-KODE)
* A BRANCH IS MADE TO A PIECE OF CODE FOR RELEVANT
* TESTING AND BRANCH TO PACKING ROUTINE
*
********************
*
* SPBINW3 IS CURRENT APPL NUMBER
ART - RETURN
APK - PACK FIELD
APF - PACK FIELD WITH SIGN
AA01 - TEST FOR FIELD TO BE
---- - AUTODUPPED
AA02 - TEST FOR AUTODUP KEY
AA03 - IF LENGTH ZERO,
---- - DELETE FIELS
AA05 - TEST FIELD 5
AA06 - TEST FIELD 6
AA11 - TEST VALOERDATE
AA17 - TEST FORFALDSAAR
AA65 - IF AA05, AA06 THERE
---- - MIGHT BE A CHOICE
---- - OF NEW TRANSTYPE
A64 - TEST FIELD 64
A65 - TEST FIELD 65
AA70 - KONTONR WITHOUT CHECK
AA71 - 'ANTAL' IN TRANSTYPE
---- - 51, 53
A76 - COUNTER, TRANS 12
A77 - TR 4, INSERT BKO 51,52
A78 - ACCOUNT NO, TRANS 12
A79 - - - - - - (COPY)
A80-A87 - CHECK OF CONTROL
---- - INFORMATION FOR
---- - TRANSTYPES
A88 - AUTODUP BKO, TR 4
A89 - STORE IN FIELD 6
A90 - SPECIAL SLUT-FIELD
A91 - ENTER TO SLUT-KEY
A100 - CHECK TR 12
A101 - CHECK BEHL. COUNT.
A102 - REL. DAY
A103 - SET BEHL. COUNT
A104 - SET TRANS 12
A105 - CTRL.DIGIT CALC.
A106 - CHECK VALUE 0-3
A107 - AS A102
A108 - SPG -REGKONTONR
A109 - SPG-CPR/CIR/NR
A110 - SPG-BELOB
A111 - SPG-OTHER FIELD
*
CBG SPBINW3,=W'89',AAA SLUT FIELD OR DIV. CHECKS
*
*
AA01
TBF GTADUPFL,AA02 AUTODUP TEST (VERIF)
CLEAR GTADUPFL IF FIELD IS TO BE AUTODUPPED
MOVE GSWBIN1,CFLTDEX(SPBINW3) GET DUP FIELD
MOVE SPINPUT,GTDUPF(GSWBIN1) AND CONTINUE
B AAA
*
AA02
TBF GTAUTODP,AA03 AUTO DUP KEY
CLEAR GTAUTODP IF GTAUTODP KEY,
MOVE GSWBIN1,CFLTDEX(SPBINW3) GET FIELD INDEX
MOVE GSSWITCH(GSWBIN1),CBIN1 AND SET GTAUTODPSWITCH FOR
RELEVANT FIELD TO BE USED
IN FORMATS
*
AA03
CBNE SPBINW1,CBIN0,AAA IF LENGTH IS ZERO
MOVE GSWBIN4,CFLTDEX(SPBINW3) GET INDEX VALUE TO GSWBIN4
MOVE GTUSED(GSWBIN4),CBIN0 DELETE FIELD
B ART
*
AAA IB SPBINW3, C
ART,ART,ART,ART,A05,A06,A07,APF,ART, FIELDS 1-9 C
APK,A11,APK,APK,APK,APK,APK,A17,APK,APK, FIELDS 10,19 C
APK,APK,APK,APK,APK,APK,APK,APK,APK,APK, FIELDS 20-29 C
APK,APK,APK,APF,APK,APK,APK,APK,APK,APF, FIELDS 30-39 C
APK,APK,APK,APK,APK,APK,APK,APF,APK,APK, FIELDS 40-49 C
APK,APK,APF,APF,A54,APF,APF,APF,APF,APF, FIELDS 50-59 C
APF,APF,APF,APK,A64,A65,APK,ART,ART,ART, FIELDS 60-69 C
A70,A71,ART,ART,ART,ART,A76,A77,A78,A79, FIELDS 70,79 C
A80,A81,A82,A83,A84,A85,A86,A87,A88,A89, FIELDS 80-89 C
A90,A91,APK,APK,APK,ART,ART,ART,ART,ART, FIELDS 90,99 C
A100,A101,A102,A103,A104, FIELDS 100,104 C
A105,A106,A107,A108,A109, FIELDS 105,109 C
A110,A111,ART,ART,ART FIELDS 110,114
**********
A05 CHECK REGISTRERINGSKONTONUMMER
MOVE GSWBIN1,SPBINW1 GET LENGTH
CBL GSWBIN1,=W'3',A065 TRANSTYPE HANDLING IN A065
CMP GSWBIN1,=W'10' LENGTH MUST BE 10
BNE A058
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
MOVE GSWBIN1,GTKTTYP
IB GSWBIN1, C
A053,A053,A051,A053,A053
A051
B APK CPR NOT NECESSARY
A053 CPR NECESSARY
IB GTREGDEX, C
A054,A055,A054,A054,A055,A054,A055,A055
A054
B APK
A055
CBL GSWBIN1,CBIN3,A056 ERROR
SET SPWARNFL WARNING
B A054
A056
MOVE SPBINW4,=W'19'
B ART
A058
MOVE SPBINW4,=W'3' SET ERRORCODE
B ART
**********
A06 CHECK CPR/CIR NUMBER
MOVE GSWBIN1,SPBINW1 GET LENGTH
CBL GSWBIN1,=W'3',A065 TRANSTYPE HANDLING IN A065
SET BCPR SET CPR-SWITCH (CPR-NO)
MOVE GSWBCD1,SPINPUT
CMP GSWBCD1,=D'10000000'
BL A061
SET BLEV LEVERAND.
CMP GSWBCD1,=D'3200000000'
BG APK
CLEAR BLEV CPR.
B APK
A061
CLEAR BCPR CLEAR CPR-SWITCH (CIR-NO)
B APK
**********
A54 FIELD 54 HAS BEEN ENTERED
MOVE GSSWITCH(CBIN2),CBIN1 AND SHOULD BE AUTODUPPED
B APK
******
A065
MOVE SPBINW1,CBIN0 SET LENGTH TO ZERO (FUNCTION)
MOVE GSWBCD3,SPINPUT GET NEW TRANSTYPE
*
CMP SPBINW2,=W'30' ADM ROUTINE
BE ART
CMP SPBINW2,=W'31' CYCLE
BE ART
*
* CHECK FOR VALID TRANSTYPE
*
* ADJUST REGDEX
A0655
*
MOVE GSWBIN1,CBIN1
* TEST FOR CORRECT TRANSACTIONS IN THIS CONNECTION
TBT GTKASSE,A0672
CBG GSWBCD3,=D'30',A067 CORRECT FOR NOT IN KASSE
B A0675
A0672
CBL GSWBCD3,=D'30',A067 CORRECT IN KASSE
B A0675
*
A067
CBE GSWBCD3,CREGTAB(GSWBIN1,GTCLASS),A068 SEARCH REGNR
ADD GSWBIN1,CBIN1 ADD 1 TO INDEX
CBNE CREGTAB(GSWBIN1,GTCLASS),=D'-1',A067 END OF TABLE?
*
A0675
MOVE SPBINW4,=W'9' INVALID TRANSTYPE
B ART
A068
TAKE CARE OF NEW TRANSTYPE
CBE SPBINW2,=W'18',A06KRE HANDLING OF KREDIT KEY
CBE SPBINW2,=W'17',A06DEB SLUT/DEB KEY
CBE SPBINW2,=W'3',A06DEB HANDLING OF DEBIT KEY
MOVE SPBINW4,=W'4' HANDLING OF WRONG KEY
B ART
A06KRE
PERF SETKRE
B A066
A06DEB
PERF SETDEB
A066
MOVE GTREGNR,GSWBCD3
MOVE GTREGDEX,GSWBIN1
SET GTREGFLG VALID TRANSTYPE FOUND
SET TTEORFLG START NEW TRANS
PERF CLRSW
*
MOVE SPBINW2,=W'36' SIMULATE TRANSACTION SELECTED
B ART
**********
A07 BKO FIELD
INSERT TEXT IN TT07TXT
CLEAR TTASKAT
MOVE GSWBCD3,SPINPUT
CBNE GSWBCD3,=D'51',A070
SET TTASKAT
A070
CBNE GTREGDEX,=W'3',A0705
CBE GSWBCD3,=D'51',A076 TRANS 3
CBE GSWBCD3,=D'52',A076
A0705
MOVE GSWBIN1,CBIN0 GET LENGTH OF STRING
COPY TT07TXT,CBIN0,CBIN5,CTTXT07,GSWBIN1
MOVE GSWBCD3,TT07TXT
MOVE GSWBIN2,GSWBCD3
MOVE TT07TXT,CBLANKS
MOVE GSWBIN1,CBIN5 FIRST CHAR, POINTER
MOVE GSWBIN3,CBIN0
CBNG SPBINW1,=W'2',A071
MOVE GSWBIN3,CBIN1 ADJUST DUPPED FIELD INDEX
A071
SUB GSWBIN1,CBIN7
A0708
ADD GSWBIN1,CBIN7
CBG GSWBIN1,GSWBIN2,A075
MATCH CTTXT07,GSWBIN1,CBIN2,SPINPUT,GSWBIN3,CBIN2
BNOK A0708
* NEXT 5 CHARS CONTAIN TEXT
ADD GSWBIN1,=W'2'
COPY TT07TXT,CBIN0,CBIN5,CTTXT07,GSWBIN1
* SEE IF ALLOWED
CBNE GTREGDEX,=W'3',A077 ONLY CHECK IF TRANSTYPE 3
ADD GSWBIN1,=W'5'
MOVE GSWSTR2,CBLANKS
COPY GSWSTR2,CBIN1,CBIN1,CTTXT07,GSWBIN1 GET TYPE
MOVE GSWBCD3,GSWSTR2
CBE GSWBCD3,=D'0',A077 OK
CBL GTREGF(CBIN2),=D'10000000',A072
CBE GSWBCD3,=D'1',A077 CPR - BKO ALLOWED
B A076
A072
CBE GSWBCD3,=D'2',A077 CIR - BKO ALLOWED
B A076
A075
TBT CBKOFLG,A077
A076
MOVE SPBINW4,=W'11'
B ART
A077
B APK
**********
A11 CHECK VAL DATE NOT GREATER
THAN POST DATE
CBE GTREGDEX,=W'3',A0110 TRANS 3
CBE GTREGDEX,=W'4',A0110 TRANS 4
B APK
A0110
* GET AND CHANGE VALOERDATE
MOVE GSWBCD6,SPINPUT
COPY GSWBCD3,CBIN4,CBIN2,GSWBCD6,CBIN12
COPY GSWBCD6,CBIN12,CBIN2,GSWBCD6,CBIN8
COPY GSWBCD6,CBIN8,CBIN2,GSWBCD3,CBIN4
* GET AND CHANGE POSTDATE
MOVE GSWBCD1,GTDATO
COPY GSWBCD3,CBIN4,CBIN2,GSWBCD1,CBIN12
COPY GSWBCD1,CBIN12,CBIN2,GSWBCD1,CBIN8
COPY GSWBCD1,CBIN8,CBIN2,GSWBCD3,CBIN4
* COMPARE
CMP GSWBCD6,GSWBCD1
BNG APK
MOVE SPBINW4,=W'7'
B ART
**********
A17 CHECK 'FORFALDSAAR' FAAR
FAAR >= 70
FAAR <= YY+2
MOVE GSWBCD6,SPINPUT GET FAAR
CBL GSWBCD6,=D'70',A17ERR LESS THAN 70: ERROR
MOVE GSWBCD1,GTDATO GET POSTDATO
MOVE GSWBCD3,=D'2'
COPY GSWBCD3,CBIN4,CBIN2,GSWBCD1,CBIN12 GET YEAR
ADD GSWBCD3,=D'2' ADD 2
CBG GSWBCD6,GSWBCD3,A17ERR MORE THAN YY+2
B APK
A17ERR
MOVE SPBINW4,=W'11' INVALID NUMBER
B ART
**********
A64
MOVE GSWBCD3,SPINPUT GET 'PRISREGULERINGSKODE'
CBG GSWBCD3,=D'5',A649
CBL GSWBCD3,=D'0',A649
FIELD 64 HAS BEEN ENTERED AND
MOVE GSSWITCH(CBIN12),CBIN1 SHOULD BE GTAUTODPPED
B APK
A649
MOVE SPBINW4,=W'10'
B ART
**********
A65 CHECK VALUE 1000-3999
MOVE GSWBCD4,SPINPUT GET VALUE
CBG GSWBCD4,=D'3999',A659
CBL GSWBCD4,=D'1000',A659
B APK
A659
MOVE SPBINW4,=W'11'
B ART
**********
A70 KONTONR WITHOUT CHECK
MOVE SPBINW3,=W'5'
CMP SPBINW1,=W'3'
BL A065 IF LENGTH < 3
B APK NEW TRANSTYPE
**********
A71
MOVE GSSWITCH(CBIN1),CBIN1 SET AUTODUP
MOVE GTSUM,SPINPUT
SUB GTSUM,=D'1' SUB 1 FROM ANTAL
MOVE SPINPUT,GTSUM
CBL GTSUM,=D'0',A715
CMP GTSUM,=D'12' IF > 12
BL ART
A715
MOVE SPINPUT,=C'51' SIMULATE NEW
MOVE SPBINW2,=W'3' TRANSTYPE
MOVE GSSWITCH(CBIN1),CBIN0 DELETE AUTODUP
B A065
**********
A76 COUNTER NO, TRANS 12
CMP SPBINW1,=W'3'
BL A065 TRANSTYPE HANDLING
MOVE GSWBCD3,SPINPUT GET VALUE
MOVE TTCNTNR,SPINPUT
SUB GSWBCD3,=D'100' GET INDEX
MOVE GSWBIN1,GSWBCD3
CBG GSWBIN1,CTR12(TTASKNR,CBIN2),A76NOK
CBL GSWBCD3,=D'1',A76NOK MIN COUNTER NO
ADD GSWBIN1,CTR12(TTASKNR,CBIN1)
CBE CTR12NR(GSWBIN1),=D'0',A76NOK
MUST BE > 0
B ART TO WRITE ON SCREEN
A76NOK
MOVE SPBINW4,=W'18'
B ART
**********
A77 INSERT 51,52 IN TR 4
MOVE SPBINW3,=W'7' FIELD 7
MOVE SPBINW1,=W'2' LENGTH
TBT BCPR,A775
MOVE SPINPUT,=X'35310000' 51 IF CIR
B A07
A775
MOVE SPINPUT,=X'35320000' 52 IF CPR
B A07
**********
A78 INSERT ACCOUNT NO
11-15
MOVE SPBINW3,=W'5' SIMULATE FIELD 5
B APK
********
A79 AUTODUP ACCOUNT NO
MOVE SPBINW3,=W'5' IN FIELD 5
MOVE GSWBIN1,TTCNTNR GET COUNTER NO
SUB GSWBIN1,=W'100'
ADD GSWBIN1,CTR12(TTASKNR,CBIN1)
MOVE SPINPUT,CTR12NR(GSWBIN1)
MOVE SPBINW1,=W'10' LENGTH
B APK
**********
A80 CHECK HOVEDBOG, KONTONR
MOVE SPBINW3,=W'5' FIELD 5
MOVE SPBINW5,=W'2' MIGHT BE TRANSTYPE 2
CBL SPBINW1,=W'3',A805 CHECK LENGTH
CBE SPBINW1,=W'10',A801 MUST BE 10
MOVE SPBINW4,=W'3' ERROR LENGTH
B ART
A801
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
PERF SELTR TRANS SELECTED
BNOK ART INVALID KEY
B APK OK
A805 CHECK FUNCTION KEYS
MOVE SPBINW1,CBIN0
CMP SPBINW2,=W'30' ADM KEY
BE ART
CMP SPBINW2,=W'31' CYCLE KEY
BE ART
MOVE SPBINW4,=W'4' INVALID KEY
B ART
**********
A81 CHECK HOVEDBOG, CPR/CIR/NR
MOVE SPBINW3,=W'6' FIELD 6
MOVE SPBINW5,=W'1' MIGHT BE TRANS TYPE 1
CBG SPBINW1,=W'2',A811 CHECK LENGTH
MOVE SPBINW4,=W'3' ERROR LENGTH
B ART
A811 CPR OR CIR ?
SET BCPR SET CPR NO
MOVE GSWBCD1,SPINPUT
CBL GSWBCD1,=D'10000000',A814
SET BLEV
CBG GSWBCD1,=D'3200000000',A812
CLEAR BLEV
B A812
A814
CLEAR BCPR SET CIR NO
A812
PERF SELTR TRANS SELECTED
BNOK ART INVALID KEY
B APK OK
**********
A82 CHECK HOVEDBOG, YD.MODT.
MOVE SPBINW3,=W'21' FIELD 21
MOVE SPBINW5,=W'6' MIGHT BE TRANSTYPE 6
A821
CBNE SPBINW2,=W'3',A822 IF ENTER KEY,
MOVE SPBINW2,=W'17' SIMULATE DEBET KEY
A822
PERF SELTR TRANS SELECTED
BNOK ART INVALID KEY
B APK OK
**********
A83 CHECK DEBITOR, DEBITOR NR
MOVE SPBINW3,=W'6' FIELD 6
CBL SPBINW1,=W'3',A805 FUNCTION?
CBL SPBINW1,=W'7',A833
MOVE SPBINW5,=W'4' MIGHT BE TRANSTYPE 4
SET BCPR SET CPR
MOVE GSWBCD1,SPINPUT
CBL GSWBCD1,=D'10000000',A831
SET BLEV
CBG GSWBCD1,=D'3200000000',A832
CLEAR BLEV
B A832
A831
CLEAR BCPR SET CIR
A832
PERF SELTR
BNOK ART
MOVE SPBINW2,=W'3'
B APK
A833
MOVE SPBINW4,=W'3' ERROR LENGTH
B ART
**********
A84 CHECK DEBITOR, BKO
MOVE SPBINW3,=W'7' FIELD 7
MOVE SPBINW5,=W'3' MIGHT BE TRANSTYPE 3
CBNE SPBINW2,=W'3',A842
MOVE SPBINW2,=W'17'
A842
MOVE GSWBCD1,SPINPUT
CBE GSWBCD1,=D'+51',A845
CBE GSWBCD1,=D'+52',A845
A843
PERF SELTR
BNOK ART
B A07
A845
MOVE SPBINW5,=W'4'
B A843
**********
A85 CHECK REMITTERING, KONTONR
MOVE SPBINW3,=W'5' FIELD 5
CBL SPBINW1,=W'3',A805 CHECK LENGTH
CBE SPBINW1,=W'10',A850 MUST BE 10
MOVE SPBINW4,=W'3' ERROR LENGTH
B ART
A850
CMP SPBINW2,=W'3' ONLY ENTER-KEY ALLOWED
BNE A855
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
B APK
A855
MOVE SPBINW4,=W'4' INVALID KEY
B ART
**********
A86 CHECK REMITTERING, LEV.NR.
MOVE SPBINW3,=W'6' FIELD 6
MOVE SPBINW5,=W'8' MIGHT BE TRANSTYPE 8
CBG SPBINW1,=W'2',A811 CHECK LENGTH + CPR/CIR
MOVE SPBINW4,=W'3' ERROR LENGTH
B ART
**********
A87 CHECK REMITTERING, YD.MODT.
MOVE SPBINW3,=W'21' FIELD 21
MOVE SPBINW5,=W'9' MIGHT BE TRANSTYPE 9
B A821 CHECK FOR INVALID KEY
**********
A88
MOVE SPBINW3,=W'7' FIELD 7
MOVE SPBINW2,=W'36'
MOVE SPBINW1,='2'
TBT BCPR,A885
MOVE SPINPUT,=X'35310000' 51 IF CIR
B A07
A885
MOVE SPINPUT,=X'35320000' 52 IF CPR
B A07
**********
A89
MOVE SPBINW3,=W'6' STORE IN FIELD 6
B APK
**********
A90 SIMULATE SLUT KEY
CLEAR GTSLUTFL
CLEAR GTADUPFL
MOVE SPBINW2,=W'17' SLUT KEY
MOVE SPBINW1,=W'0' LENGTH ZERO
B ART
**********
A91 ENTER TO SLUT KEY
CMP SPBINW2,=W'3'
BNE ART
MOVE SPBINW2,=W'17'
B ART
**********
A100 CHECK TR 12 COUNTERS
MOVE GSWBCD1,SPINPUT
SUB GSWBCD1,=D'100'
MOVE GSWBIN6,GSWBCD1
CBL GSWBIN6,CBIN1,A1009 TOO SMALL
CBG GSWBIN6,CTR12(TTASKNR,CBIN2),A1009 TOO HIGH
ADD GSWBIN6,CTR12(TTASKNR,CBIN1)
B ART
A1009
MOVE SPBINW4,=W'11'
B ART
**********
A101 CHECK BEHL. COUNTERS
MOVE GSWBCD1,SPINPUT
CBL GSWBCD1,=D'1',A101ER
MOVE GSWBIN6,GSWBCD1
CBG GSWBIN6,CBEH(TTASKNR,CBIN2),A101ER
ADD GSWBIN6,CBEH(TTASKNR,CBIN1)
B ART
A101ER
MOVE SPBINW4,=W'11'
B ART
**********
A102 CHECK RELATIVE DAY
MOVE GSWBCD7,CMASKDAT
A102A
MOVE GSWBCD5,=D'2' INITIATE REL DAY NO.
MOVE GSWBCD3,=D'1' BLANK GSWBCD3
MOVE GSWBIN2,CBIN8 SET POINTER TO DAY
COPY GSWBCD3,CBIN4,CBIN2,GSWBCD7,GSWBIN2 GET DAY
ADD GSWBCD5,GSWBCD3 ADD DAY TO REL. DAY
ADD GSWBIN2,CBIN2 SET POINTER TO MONTH
COPY GSWBCD3,CBIN4,CBIN2,GSWBCD7,GSWBIN2 GET MONTH
SUB GSWBCD3,=D'1' GET WHOLE NO. OF MONTHS
MUL GSWBCD3,=D'30' EQUAL IN DAYS
ADD GSWBCD5,GSWBCD3
MOVE GSWBCD3,SPINPUT GET KEYED REL. DAY
SUB GSWBCD5,=D'5'
CBL GSWBCD3,GSWBCD5,A102ER TOO SMALL
ADD GSWBCD5,=D'10'
CBG GSWBCD3,GSWBCD5,A102ER TOO LARGE
B A102END
A102ER
MOVE SPBINW4,=W'11' INVALID VALUE
A102END
MOVE GSWBCD3,=X'FF'
B ART
**********
A103 SET BEHL. COUNTERS
MOVE GSWBCD3,SPINPUT
MOVE GSWBIN6,GSWBCD3
ADD GSWBIN6,CBEH(GSWBIN1,CBIN1)
CBG GSWBIN6,=W'60',A103ER TOO MANY
CBE GSWBIN1,CBIN12,A1035
ADD GSWBIN1,CBIN1
MOVE CBEH(GSWBIN1,CBIN1),GSWBIN6
SUB GSWBIN1,CBIN1
A1035
MOVE GSWBIN6,GSWBCD3
MOVE CBEH(GSWBIN1,CBIN2),GSWBIN6
B ART
A103ER
MOVE SPBINW4,=W'11'
B ART
**********
A104 SET TR 12 COUNTERS
MOVE GSWBCD4,SPINPUT
MOVE GSWBIN6,GSWBCD4
ADD GSWBIN6,CTR12(GSWBIN1,CBIN1)
CBG GSWBIN6,=W'60',A104ER TOO MANY
CBE GSWBIN1,CBIN12,A1045
ADD GSWBIN1,CBIN1
MOVE CTR12(GSWBIN1,CBIN1),GSWBIN6
SUB GSWBIN1,CBIN1
A1045
MOVE GSWBIN6,GSWBCD4
MOVE CTR12(GSWBIN1,CBIN2),GSWBIN6
B ART
A104ER
MOVE SPBINW4,=W'11'
B ART
**********
A105 CONRTL.DIGITCALC.
MOVE GSWBCD6,SPINPUT
CBE SPBINW2,=W'3',CALCD01
CMP SPBINW2,=W'17'
BNE ART
CALCD01
MOVE GSWBIN1,SPBINW1 GET LENGTH
MOVE GSWBIN2,=W'13'
MOVE GSWBCD5,=D'0'
CALCD02
MOVE GSWBCD3,=D'0'
COPY GSWBCD3,CBIN5,CBIN1,GSWBCD6,GSWBIN2 GET NEXT DIGIT
MUL GSWBCD3,WEIGTH(GSWBIN2) MULTIPLY BY WEIGHT
ADD GSWBCD5,GSWBCD3 ADD TO OLD SUM
SUB GSWBIN1,=W'1' ADJUST LENGTH
SUB GSWBIN2,=W'1' ADJUST WEIGHT-INDEX
CBG GSWBIN1,=W'0',CALCD02
MOVE GSWBCD4,GSWBCD5
DIV GSWBCD5,=D'11'
MUL GSWBCD5,=D'11'
SUB GSWBCD4,GSWBCD5 GET REMAINDER MOD 11
CBNE GSWBCD4,=D'0',CALCD05
MOVE GSWBCD4,=D'11'
CALCD05
MOVE GSWBCD5,=D'11'
SUB GSWBCD5,GSWBCD4 CALCULATE CONTROLDIGIT
B ART
**********
A106 CHECK VALUE 0-3
MOVE GSWBCD3,SPINPUT GET VALUE
CBL GSWBCD3,=D'6',ART
MOVE SPBINW4,=W'11' ERROR 'OUT OF RANGE'
B ART
**********
A107 REL DAY, 'POSTERINGSDATO'
MOVE GSWBCD7,GTDATO
B A102A
**********
A108 SPG-REGKONTONR
MOVE GSWBCD6,=D'5'
B ART
**********
A109 SPG-CPR/CIR/NR
MOVE GSWBCD6,=D'6'
B ART
**********
A110 SPG-BELOB
MOVE GSWBCD6,=D'8'
B ART
**********
A111 SPG-OTHER FIELD
MOVE GSWBCD6,SPINPUT
CBG GSWBCD6,=D'90',A111ERR
MOVE GSWBCD7,=D'0'
B ART
A111ERR
MOVE SPBINW4,=W'11'
B ART
**********
APK KEEP INFORMATION
TBF TTEORFLG,APK00 FIRST FIELD?
CBE SPBINW3,=W'5',APK10
MOVE GTKTTYP,=D'0' NOT KONTONR.
APK10
PERF PACKCL YES, CLEAR GTUSED
PERF CRKJ
SET SPME CHECK FOR ME FIELDS
APK00
MOVE GSWBIN1,CFLTDEX(SPBINW3) GET INDEX OF FIELD
MOVE GTUSED(GSWBIN1),SPBINW3 STORE FIELDNUMBER
B ART
**********
APF
TBF TTEORFLG,APF00 FIRST FIELD?
MOVE GTKTTYP,=D'0'
PERF PACKCL YES, CLEAR GTUSED
PERF CRKJ
SET SPME CHECK FOR ME FIELDS
APF00
TBT SPDUPL,APF10
MOVE GSWBCD6,SPINPUT GET VALUE
MUL GSWBCD6,GTDBKRS
MOVE SPINPUT,GSWBCD6
APF10
MOVE GSWBIN1,CFLTDEX(SPBINW3) GET INDEX OF CURRENT FIELD
* MULTIPLY WITH -1 IF KREDIT
* STORE NEGATIVE FIELD NUMBER (NUMBER WITH SIGN)
MOVE GTUSED(GSWBIN1),SPBINW3
MUL GTUSED(GSWBIN1),=W'-1'
B ART
**********
ART
MOVE SPBINW3,CBIN1
CBL SPBINW4,CBIN3,ARET
MOVE SPBINW3,CBIN3
ARET
RET
PEND
********************
EJECT
SETKRE PROC
********************
*
* SETKRE - SET KREDIT INFORMATION
*
********************
MOVE GTDBKRC,=C' KRE'
MOVE GTDBKRS,=D'-1'
MOVE TTDKBCD,=D'1'
MOVE TTDKDEX,=W'1'
RET
PEND
*
*
*
*
*
SETDEB PROC
********************
*
* SETDEB - SET DEBET INFORMATION
*
********************
MOVE GTDBKRC,=C' DEB'
MOVE GTDBKRS,=D'+1'
MOVE TTDKBCD,=D'2'
MOVE TTDKDEX,=W'2'
RET
PEND
EJECT
CLRSW PROC
********************
*
* CLRSW - CLEAR ALL AUTODUP FLAGS
*
********************
MOVE GSWBIN1,CBIN1
CLRSW1
MOVE GSSWITCH(GSWBIN1),CBIN0
ADD GSWBIN1,CBIN1
CBL GSWBIN1,CBINMAX,CLRSW1
RET
PEND
EJECT
SELTR PROC
********************
*
* SELTR - PROCEDURE TO SEE IF TRANSTYPE HAS BEEN
* SELECTED.
* SELECTED TRANSTYPE IS IN SPBINW5
*
********************
CBE SPBINW2,=W'3',SELOK ENTER KEY
CBE SPBINW2,=W'18',SEL10 KREDIT KEY
CBE SPBINW2,=W'17',SEL20 DEBET KEY
MOVE SPBINW4,=W'4' INVALID KEY
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
SEL10 KREDIT
PERF SETKRE
B SEL30
SEL20 DEBET
PERF SETDEB
SEL30 TRANSTYPE SELECTED
MOVE GSWBIN1,GTKTTYP
IB GSWBIN1, C
SEL40,SEL40,SEL90,SEL40,SEL40
B SEL90
SEL40
IB SPBINW5, C
SEL90,SEL45,SEL90,SEL90,SEL90,SEL90,SEL90,SEL45,SEL90
SEL45
CBL GSWBIN1,CBIN3,SEL50
SET SPWARNFL WARNING
B SEL90
SEL50
MOVE SPBINW4,=W'19' ERROR
CMP CBIN1,CBIN0
RET
SEL90
MOVE GTREGNR,SPBINW5 TYPE
MOVE GTREGDEX,SPBINW5 TYPE INDEX. OK FOR <11
MOVE SPBINW2,=W'36' SIMULATE TRANS SELECTED
SET GTTRSEL
SELOK
CMP CBIN0,CBIN0 OK, SET CR=0
RET
PEND
*
*
*
*
*
END