|
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: 39906 (0x9be2)
Notes: pts_type(SC)
Names: »SUBAPL.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/SUBAPL.SC«
IDENT SUBAPL 820903 NJ
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 SELTR
ENTRY CHDATO
ENTRY XCOP
ENTRY YYMMDD
EXT KBTEST
EXT ABORT
EXT SPLIN8
EXT PACKCL
EXT CRKJ
EXT KKCH
EXT KTPLAN
EXT TXTRD
EXT LEVRD
EXT REPL00
INCLUDE EQUATE
*
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,CBIN3,CHK1RET FOR LENGTH < 3, NO CHECK
CBL GSWBIN1,CBIN7,CHK1ER IF 2<LENGTH<7, ERROR
CBE GSWBIN1,CBIN7,CHK10 IF LENGTH = 7, OK (CIRNR)
CBNE GSWBIN1,CBIN10,CHK1ER IF LENGTH = 10, OK (CPRNR)
CHK10
MOVE GSWBIN2,CBIN13
MOVE GSWBCD5,=D'0'
MOVE GSWBCD6,SPINPUT GET ITEM TO BE CHECKED
TBT GTADMFLG,CHK11
CBL GSWBCD6,=D'1',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,CBIN1 ADJUST WEIGHT INDEX
SUB GSWBIN1,CBIN1 ADJUST LENGTH OF ITEM
CBNE GSWBIN1,CBIN0,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
CBL GSWBCD4,=D'1',CHK1RET IF REMAINDER 0, THEN RETURN
CHK1ER
MOVE SPBINW4,CBIN6
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,CBIN10 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,CBIN2 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,CBIN7 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,CBIN7 SET ERRORCODE
CH3RET
RET
PEND
EJECT
SPCHK4 PROC
********************
*
* SPCHK4 - CHANGE SIGN ON VALUE, IF KREDIT KEY
*
********************
MOVE SPBINW3,CBIN1
CBNE SPBINW2,CBIN18,CH4RET
MOVE GSWBCD7,SPINPUT IF KREDIT KEY
MUL GSWBCD7,=D'-1'
MOVE SPINPUT,GSWBCD7
MOVE SPBINW2,CBIN3 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
CBNL GSWBIN1,CVOUTOP,CH5ERR
CBL GSWBIN1,CMINLIN,CH5ERR
RET
CH5ERR
MOVE SPBINW3,CBIN3
MOVE SPBINW4,CBIN8
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
CBL GSWBCD3,=D'1',CH6RET NO CHECK IF ZERO
CBE GSWBCD3,TTKTCHK,CH6RET OK
MOVE SPBINW3,CBIN3 ERROR
MOVE SPBINW4,CBIN13
CH6RET
RET
PEND
SPCHK7 PROC
**********
*
* SPCHK7- CDVCHECK (USES SPCHK1)
* INSERTS CHECKDIGIT, IF LENGTH=8
*
* PERFORMS CHECKDIGIT CHECK ON VALUE IN SPINPUT
* IF ERROR, ERRORCODE 6 IS MOVED TO SPBINW4
* FIELD MUST BE 7 OR 10 LONG
* IF FIELD IS 8 LONG, IT IS ASSUMED TO BE A PHONE NUMBER,
* AND IS THEN CHANGED FROM 0XXXXXXX TO 5XXXXXXXCC
*
**********
*
TBF CLEV8FLG,CHK705
MOVE GSWBIN1,SPBINW1 GET LENGTH
CBE GSWBIN1,CBIN8,CHK710 SPECIAL TREATMENT OF PHONE NO
CHK705
PERF SPCHK1 ELSE NORMAL CDVCHK
B CHK7RET
*
CHK710
MOVE SPBINW4,CBIN0
MOVE GSWBCD6,SPINPUT +FFFFF0XXXXXXX
TBT C539FLG,CHK720 JUMP IF TINGLEV
MOVE GSWBCD3,=D'5' +FFFF5
COPY GSWBCD6,CBIN6,CBIN1,GSWBCD3,CBIN5
CHK720
MUL GSWBCD6,=D'10' +FFFF5XXXXXXX0
MOVE SPINPUT,GSWBCD6
MOVE SPBINW1,CBIN9 SET LENGTH
MOVE SPBINW5,SPBINW2 SAVE END KEY
MOVE SPBINW2,CBIN3 SIMULATE KEY
MOVE SPBINW3,=W'105' APPL VALUE
PERF SPAPPL CALCULATE CONTROL DIGIT
MOVE SPBINW2,SPBINW5 RESTORE KEY VALUE
CBNE GSWBCD5,=D'10',CHK730 CHECK CONTROLDIGIT
MOVE GSWBCD5,=D'50' SET CONTROL DIGIT
CHK730
MUL GSWBCD6,=D'10' ROOM FOR CONTROLDIGIT
ADD GSWBCD6,GSWBCD5 INSERT CONTROL DIGIT
MOVE SPBINW1,CBIN10 SET LENGTH
MOVE SPINPUT,GSWBCD6
CHK7RET
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,CBIN16 ADJUST INDEX
IB SPBINW3, C
TCHK17,TCHK18,TCHK19,TCHK20
SUB SPBINW3,=W'61' +16-77
IB SPBINW3,TCHK78,TCHK79
SUB SPBINW3,=W'38' 116-119
IB SPBINW3,TCHK116,TCHK117,TCHK118,TCHK119
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
*
TCHK116
MOVE SPBINW3,GTTXTTKO
IB SPBINW3,TCHK99,TCHK00,TCHK00,TCHK99,TCHK99,TCHK00
B TCHK99
*
TCHK117
MOVE SPBINW3,GTTXTTKO
IB SPBINW3,TCHK99,TCHK99,TCHK00,TCHK99,TCHK99,TCHK99
B TCHK99
*
TCHK118
MOVE SPBINW3,GTTXTTKO
IB SPBINW3,TCHK99,TCHK99,TCHK99,TCHK00,TCHK00,TCHK00
B TCHK99
*
TCHK119
MOVE SPBINW3,GTTXTTKO
IB SPBINW3,TCHK99,TCHK99,TCHK99,TCHK99,TCHK00,TCHK99
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
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.
A107 - AS A102
A108 - SPG -REGKONTONR
A109 - SPG-CPR/CIR/NR
A110 - SPG-BELOB
A111 - SPG-OTHER FIELD
A115 REMIT-TXT
A120 - BUDGET
*
CBL SPBINW3,=W'90',AA01
CBG SPBINW3,=W'114',AA01
B AAA 90-114
*
AA01
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,A57,A57,A57,A57,A57, FIELDS 50-59 C
A57,A57,A57,APK,A64,A65,APK,ART,ART,ART, FIELDS 60-69 C
APK,APK,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,A92,A93,A94,ART,ART,ART,ART,ART, FIELDS 90,99 C
A100,A101,A102,A103,A104, FIELDS 100,104 C
A105,ART,A107,A108,A109, FIELDS 105,109 C
A110,A111,ART,ART,ART, FIELS 110,114 C
A115,A116,A117,A118,A119,A120, FIELDS 115,120 C
A121,A122,APK,APK,APK, FIELDS 121-125 C
ART,ART,ART,ART,A130,A131,A132
**********
A05 CHECK REGISTRERINGSKONTONUMMER
MOVE GSWBIN1,SPBINW1 GET LENGTH
CBE GSWBIN1,CBIN4,A059 LENGTH = 4?
CBL GSWBIN1,CBIN3,A065 TRANSTYPE HANDLING IN A065
CMP GSWBIN1,CBIN10 LENGTH MUST BE 10
BNE A058
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
MOVE GSWBIN1,GTKTTYP
IB GSWBIN1, C
A053,A053,A051,A053,A053,A052,A0570,A0575
A051
B APK CPR NOT NECESSARY
A052 REMIT. NOT ALLOWED
IB GTREGDEX, C
A0520,A0520,A0520,A0520,A0520, TR 1,2,3,4,5 C
A0520,A0520,A0525,A0525,A0520, TR 6,7,8,9,10 C
A0520,A0525,A0525,A0525,A0525 TR 12,18,19,28,29
A0520
B APK
A0525
MOVE SPBINW4,CBIN20 ERROR
B ART
A053 CPR NECESSARY
IB GTREGDEX, C
A054,A055,A054,A054,A055, TR 1,2,3,4,5 C
A054,A055,A055,A054,A054, TR 6,7,8,9,10 C
A054,A055,A054,A055,A054 TR 12,18,19,28,29
A054
B APK
A055
CBL GSWBIN1,CBIN3,A056 ERROR
SET SPWARNFL WARNING
B A054
A056
MOVE SPBINW4,CBIN19
B ART
*
A0570 7: KNT.NO. NOT ALLOWED
MOVE SPBINW4,=W'23'
B ART
*
A0575 8:KNT.NO. NOT ALLOWED IN SUPL
CBE GTREGDEX,CBIN10,A0577 TR 10
TBT TTSUPFLG,A0577 SUPL
B APK OK
A0577 NOT OK
MOVE SPBINW4,CBIN22
B ART
*
A059
CBL GTREGNR,=D'48',A058 ONLY ALLOWED WHEN
CBG GTREGNR,=D'49',A058 IN BUDGET TR.48/49
B APK
*
A058
MOVE SPBINW4,CBIN3 SET ERRORCODE
B ART
**********
A06 CHECK CPR/CIR NUMBER
MOVE GSWBIN1,SPBINW1 GET LENGTH
CBL GSWBIN1,CBIN3,A065 TRANSTYPE HANDLING IN A065
SET BCPR SET CPR-SWITCH (CPR-NO)
MOVE GSWBCD1,SPINPUT
CBL GSWBCD1,=D'10000000',A061
SET BLEV LEVERAND.
CBG GSWBCD1,=D'3900000000',A062
CLEAR BLEV CPR.
B A062
A061
CLEAR BCPR CLEAR CPR-SWITCH (CIR-NO)
A062
TBT GTBDTFLG,A0625 BUNDT REMIT
TBT GTSTRFLG,A0621 STRAKS REMIT
B APK NOT REMIT
*
A0621
MOVE GTLEVNR,GSWBCD1 STRAKS REMIT, SET LEVNR
PERF LEVRD
BOK A0622
NOT OK, LEV FINDES IKKE
SET SPWARNFL SET WARNING
B APK
A0622
CBG GTLEVBFO,=D'4',A0629 ONLY 0-4 VALID
B A063
*
A0625 BUNDT REMIT
TBT CAD41FLG,A0630
MOVE GTLEVNR,GSWBCD1 SET LEVNR
PERF LEVRD
BNOK A0629
CBE GTLEVBFO,=D'0',A0629
A063
TBF GTCYFLG,A064
MOVE GSSWITCH(CBIN2),CBIN1
A064
B APK
A0629 WRONG BETALINGSFORM
MOVE SPBINW4,CBIN11 ERROR
B ART
A0630
MOVE SPBINW4,=W'12' ADM 41,42,43,46
B ART
**********
A54 FIELD 54 HAS BEEN ENTERED
* THE FIELD WITH LENGTH N (N = 1,2,...,10)
* HAS TO BE LEFT-JUSTIFIED AND EXPANDED
* TO THE LENGTH 10.
MOVE GSWSTR20,=C'0'
MOVE GSWBIN1,CBIN10
SUB GSWBIN1,SPBINW1 HOW MANY ZEROES ?
INSRT SPINPUT,SPBINW1,GSWBIN1,GSWSTR20,CBIN0
MOVE SPBINW1,CBIN10 ADJUST LENGTH
B APK
**********
A57
B APF
******
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
*
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,CBIN1),A068 SEARCH REGNR
ADD GSWBIN1,CBIN1 ADD 1 TO INDEX
CBNE CREGTAB(GSWBIN1,CBIN1),=D'-1',A067 END OF TABLE?
*
A0675
MOVE SPBINW4,CBIN9 INVALID TRANSTYPE
B ART
A068
TAKE CARE OF NEW TRANSTYPE
CBE SPBINW2,CBIN18,A0680 HANDLING OF KREDIT KEY
CBE SPBINW2,CBIN17,A0680 SLUT/DEB KEY
CBE SPBINW2,CBIN3,A0680 HANDLING OF DEBIT KEY
MOVE SPBINW4,CBIN4 HANDLING OF WRONG KEY
B ART
A0680
TBT GTCYFLG,A0685 CYKEL TABEL ?
CLEAR GTBDTFLG NO, CLEAR FLAGS
CLEAR GTSTRFLG
CBL GSWBCD3,=D'28',A0681
SET GTBDTFLG TRANS 28,29
B A0689
A0681
CBL GSWBCD3,=D'18',A0689
SET GTSTRFLG TRANS 18,19
B A0689
A0685 IN CYKEL/STABEL
TBF GTBDTFLG,A0686 TRANS 28,29 ?
CBL GSWBCD3,=D'28',A0675 IF NOT, INVALID TRANS
B A0689 VALID TRANS
A0686
TBT GTSTRFLG,A0687 TRANS 18, 19 ?
NO, ONLY TRANS 1-12
CBG GSWBCD3,=D'12',A0675 IF NOT, INVALID TRANS
B A0689 VALID TRANS
A0687
TRANS 18,19
CBL GSWBCD3,=D'18',A0675 TR 1-12 INVALID
CBL GSWBCD3,=D'28',A0689 TR 18,19 VALID
B A0675 TR 28,29 INVALID
A0689
CBE SPBINW2,CBIN18,A06KRE KREDIT KEY
B A06DEB
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
*
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,CBIN3,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,=' '
MOVE GSWBIN1,CBIN5 FIRST CHAR, POINTER
MOVE GSWBIN3,CBIN0
CBNG SPBINW1,CBIN2,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,CBIN2
COPY TT07TXT,CBIN0,CBIN5,CTTXT07,GSWBIN1
* SEE IF ALLOWED
CBNE GTREGDEX,CBIN3,A077 ONLY CHECK IF TRANSTYPE 3
ADD GSWBIN1,CBIN5
MOVE GSWSTR2,=' '
COPY GSWSTR2,CBIN1,CBIN1,CTTXT07,GSWBIN1 GET TYPE
MOVE GSWBCD3,GSWSTR2
CBL GSWBCD3,=D'1',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,CBIN11
B ART
A077
B APK
**********
A11 CHECK VAL DATE NOT GREATER
THAN POST DATE
CBE GTREGDEX,CBIN3,A0110 TRANS 3
CBE GTREGDEX,CBIN4,A0110 TRANS 4
TBF TTCY1FLG,A01101
TBF GTBDTFLG,A01101
MOVE GSSWITCH(CBIN7),CBIN1
A01101
B APK
A0110
TBF CVALFLG,A01101
* GET AND CHANGE VALOERDATE
MOVE GSWBCD6,SPINPUT
PERF YYMMDD,GSWBCD6
MOVE GSWBCD1,GSWBCD7
* GET AND CHANGE POSTDATE
PERF YYMMDD,GTDATO
* COMPARE
CMP GSWBCD1,GSWBCD7
BNG APK
MOVE SPBINW4,CBIN7
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,CBIN11 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,CBIN10
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,CBIN11
B ART
**********
A76 COUNTER NO, TRANS 12
CMP SPBINW1,CBIN3
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)
CBL CTR12NR(GSWBIN1),=D'1',A76NOK
MUST BE > 0
B ART TO WRITE ON SCREEN
A76NOK
MOVE SPBINW4,CBIN18
B ART
**********
A77 INSERT 51,52 IN TR 4
MOVE SPBINW3,CBIN7 FIELD 7
MOVE SPBINW1,CBIN2 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,CBIN5 SIMULATE FIELD 5
B APK
********
A79 AUTODUP ACCOUNT NO
MOVE SPBINW3,CBIN5 IN FIELD 5
MOVE GSWBIN1,TTCNTNR GET COUNTER NO
SUB GSWBIN1,=W'100'
ADD GSWBIN1,CTR12(TTASKNR,CBIN1)
MOVE SPINPUT,CTR12NR(GSWBIN1)
MOVE SPBINW1,CBIN10 LENGTH
B APK
**********
A80 CHECK HOVEDBOG, KONTONR
MOVE SPBINW3,CBIN5 FIELD 5
MOVE SPBINW5,CBIN2 MIGHT BE TRANSTYPE 2
CBL SPBINW1,CBIN3,A805 CHECK LENGTH
CBE SPBINW1,CBIN10,A801 MUST BE 10
MOVE SPBINW4,CBIN3 ERROR LENGTH
B ART
A801
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
MOVE GSWBIN1,GTKTTYP
CMP GSWBIN1,CBIN7 7: KNT.NO. NOT ALLOWED
BE A0570
CBNE GSWBIN1,CBIN8,A804
TBF TTSUPFLG,A804
B A0577 8:KNT.NO. NOT ALLOWED IN SUPL
A804
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,CBIN4 INVALID KEY
B ART
**********
A81 CHECK HOVEDBOG, CPR/CIR/NR
MOVE SPBINW3,CBIN6 FIELD 6
MOVE SPBINW5,CBIN1 MIGHT BE TRANS TYPE 1
CBG SPBINW1,CBIN2,A811 CHECK LENGTH
MOVE SPBINW4,CBIN3 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,CBIN21 FIELD 21
MOVE SPBINW5,CBIN6 MIGHT BE TRANSTYPE 6
A821
CBNE SPBINW2,CBIN3,A822 IF ENTER KEY,
MOVE SPBINW2,CBIN17 SIMULATE DEBET KEY
A822
PERF SELTR TRANS SELECTED
BNOK ART INVALID KEY
B APK OK
**********
A83 CHECK DEBITOR, DEBITOR NR
MOVE SPBINW3,CBIN6 FIELD 6
CBL SPBINW1,CBIN3,A805 FUNCTION?
CBL SPBINW1,CBIN7,A833
MOVE SPBINW5,CBIN4 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,CBIN3
B APK
A833
MOVE SPBINW4,CBIN3 ERROR LENGTH
B ART
**********
A84 CHECK DEBITOR, BKO
MOVE SPBINW3,CBIN7 FIELD 7
MOVE SPBINW5,CBIN3 MIGHT BE TRANSTYPE 3
CBNE SPBINW2,CBIN3,A842
MOVE SPBINW2,CBIN17
A842
MOVE GSWBCD1,SPINPUT
CBE GSWBCD1,=D'+51',A845
CBE GSWBCD1,=D'+52',A845
A843
PERF SELTR
BNOK ART
B A07
A845
MOVE SPBINW5,CBIN4
B A843
**********
A85 CHECK REMITTERING, KONTONR
MOVE SPBINW3,CBIN5 FIELD 5
CBL SPBINW1,CBIN3,A805 CHECK LENGTH
CBE SPBINW1,CBIN10,A850 MUST BE 10
MOVE SPBINW4,CBIN3 ERROR LENGTH
B ART
A850
CMP SPBINW2,CBIN3 ONLY ENTER-KEY ALLOWED
BNE A855
MOVE GSWBCD1,SPINPUT
PERF KTPLAN,GSWBCD1,GTKTTYP
MOVE GSWBIN1,GTKTTYP
CBE GSWBIN1,CBIN6,A853 6: REMIT NOT ALLOWED
CMP GSWBIN1,CBIN7 7:KNT.NO. NOT ALLOWED
BE A0570
CBNE GSWBIN1,CBIN8,A854
TBF TTSUPFLG,A854
B A0577 8:KNT.NO. NOT ALLOWED IN SUPL
A853
MOVE SPBINW4,CBIN20 REMIT NOT ALLOWED
B ART
A854
B APK
A855
MOVE SPBINW4,CBIN4 INVALID KEY
B ART
**********
A86 CHECK REMITTERING, LEV.NR.
MOVE SPBINW3,CBIN6 FIELD 6
MOVE SPBINW5,CBIN8 MIGHT BE TRANSTYPE 8
CMP SPBINW1,CBIN2 CHECK LENGTH + CPR/CIR
BG A811
MOVE SPBINW4,CBIN3 ERROR LENGTH
B ART
**********
A87 CHECK REMITTERING, YD.MODT.
MOVE SPBINW3,CBIN21 FIELD 21
MOVE SPBINW5,CBIN9 MIGHT BE TRANSTYPE 9
B A821 CHECK FOR INVALID KEY
**********
A88
MOVE SPBINW3,CBIN7 FIELD 7
MOVE SPBINW2,=W'36'
MOVE SPBINW1,CBIN2
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,CBIN6 STORE IN FIELD 6
B APK
**********
A121 SIMULATE SLUT KEY
CLEAR GTSLUTFL
CLEAR GTADUPFL
MOVE SPBINW2,CBIN17 SLUT KEY
MOVE SPBINW1,CBIN0 LENGTH ZERO
B ART
**********
A122 ENTER TO SLUT KEY
CMP SPBINW2,CBIN3
BNE ART
MOVE SPBINW2,CBIN17
B ART
**********
A90
PERF SPACES
MOVE GTFELT90(CBIN1),SPINPUT
B APK
***
A91
PERF SPACES
MOVE GTFELT90(CBIN2),SPINPUT
B APK
***
A92
PERF SPACES
MOVE GTFELT90(CBIN3),SPINPUT
B APK
***
A93
PERF SPACES
MOVE GTFELT90(CBIN4),SPINPUT
B APK
***
A94
PERF SPACES
MOVE GTFELT90(CBIN5),SPINPUT
B APK
***
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,CBIN11
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,CBIN11
B ART
**********
A102 CHECK RELATIVE DAY
MOVE GSWBCD7,CMASKDAT
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,CBIN11 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,CBIN11
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,CBIN11
B ART
**********
A105 CONRTL.DIGITCALC.
MOVE GSWBCD6,SPINPUT
CBE SPBINW2,CBIN3,CALCD01
CMP SPBINW2,CBIN17
BNE ART
CALCD01
MOVE GSWBIN1,SPBINW1 GET LENGTH
MOVE GSWBIN2,CBIN13
MOVE GSWBCD5,=D'0'
CALCD02
MOVE GSWBCD3,=D'0'
COPY GSWBCD3,CBIN5,CBIN1,GSWBCD6,GSWBIN2 GET NEXT DIGIT
SUB GSWBIN2,CBIN1 ADJUST WEIGHT-INDEX
MUL GSWBCD3,WEIGTH1(GSWBIN2) MULTIPLY BY WEIGHT
ADD GSWBCD5,GSWBCD3 ADD TO OLD SUM
SUB GSWBIN1,CBIN1 ADJUST LENGTH
CBG GSWBIN1,CBIN0,CALCD02
MOVE GSWBCD4,GSWBCD5
DIV GSWBCD5,=D'11'
MUL GSWBCD5,=D'11'
SUB GSWBCD4,GSWBCD5 GET REMAINDER MOD 11
CBNL GSWBCD4,=D'1',CALCD05
MOVE GSWBCD4,=D'11'
CALCD05
MOVE GSWBCD5,=D'11'
SUB GSWBCD5,GSWBCD4 CALCULATE CONTROLDIGIT
B ART
**********
A107 POSTDATO=MASKINDATO ?
MOVE GSWBCD7,SPINPUT
CBNE GSWBCD7,CMASKDAT,A1075
B ART
A1075
SET SPWARNFL
B ART
**********
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,CBIN11
B ART
**********
A115 TEXTNR REMITTERING
MOVE GSWBCD6,SPINPUT
MOVE GSWBIN8,GSWBCD6
PERF TXTRD,GSWBIN8 READ TEXT
BNOK A1154
CBE GTWBCD1,=D'10',A1154 END OF FILE
CBL GTTXTTKO,=D'1',A1154 DELETED
CLEAR GTSWFLAG
MOVE SPBINW3,=W'26'
A1151
TBF TTCY1FLG,A1153
TBT GTBDTFLG,A1152
TBF GTSTRFLG,A1153
A1152
MOVE GSWBIN1,CFLTDEX(SPBINW3)
MOVE GSSWITCH(GSWBIN1),CBIN1
A1153
B APK
A1154
MOVE SPBINW4,CBIN11 TEXT MISSING
B ART
**********
A116
MOVE SPBINW3,=W'24'
B A1151
**********
A117
MOVE SPBINW3,=W'25'
B A1151
**********
A118
MOVE SPBINW3,=W'37'
B A1151
**********
A119
MOVE SPBINW3,=W'38'
B A1151
**********
A120
* VALUESET: CURRENT YEAR +/- 1
MOVE GSWBCD1,CMASKDAT DDMMYY
MOVE GSWBCD2,CMASKDAT
DIV GSWBCD1,=D'100' DDMM
MUL GSWBCD1,=D'100' DDMM00
SUB GSWBCD2,GSWBCD1 YY
MOVE GSWBCD1,GSWBCD2
SUB GSWBCD1,=D'1'
ADD GSWBCD2,=D'1'
MOVE GSWBCD3,SPINPUT
CBL GSWBCD3,GSWBCD1,A120E
CBG GSWBCD3,GSWBCD2,A120E
B APK
A120E
MOVE SPBINW4,CBIN11
B ART
**********
A130
* USED IN "NYSTART"
MOVE GSWBCD3,SPINPUT
MOVE GSWBIN1,GSWBCD3
IB GSWBIN1,A1301,A1302,A1303
MOVE SPBINW4,CBIN11
B ART
A1301
MOVE GTSTRFMT,=C'SYSSTART '
B A1305
A1302
MOVE GTSTRFMT,=C'RESTART '
B A1305
A1303
MOVE GTSTRFMT,=C'RESTORE '
A1305
MOVE GSWBIN1,=X'0516' LINE 5, POS 22
DSC1 SCREEN,POS,GSWBIN1
EDWRT SCREEN,STRTFRM
B ART
**********
A131
* USED IN "NYSTART"
MOVE GSWBCD3,SPINPUT
MOVE GSWBIN1,GSWBCD3
IB GSWBIN1,A1311,A1312,A1313
MOVE SPBINW4,CBIN11
B ART
A1311
MOVE GTSTRFMT,=C'SYSVOL '
B A1315
A1312
MOVE GTSTRFMT,=C'REGVOL '
B A1315
A1313
MOVE GTSTRFMT,=C'AFBRYD '
A1315
MOVE GSWBIN1,=X'0711'
DSC1 SCREEN,POS,GSWBIN1
EDWRT SCREEN,STRTFRM
B ART
**********
STRTFRM FRMT
FILLR '+',2
FCOPY GTSTRFMT
FMEND
**********
A132
MOVE GSWBCD1,SPINPUT
MOVE GSWBIN1,=X'0301'
DSC1 SCREEN,POS,GSWBIN1
EDIT CVOL(CBIN2),A132FMT2
EDIT CVOL(CBIN3),A132FMT3
EDIT CVOL(CBIN4),A132FMT4
EDWRT SCREEN,A132FMT1
B ART
A132FMT1 FRMT
FILLR '+',2
FCOPY CVOL(CBIN2)
FILLR ' ',1
FCOPY CVOL(CBIN3)
FILLR ' ',1
FCOPY CVOL(CBIN4)
FMEND
A132FMT2 FRMT
FMEL '999',GSWBCD1
FTEXT '002'
FMEND
A132FMT3 FRMT
FMEL '999',GSWBCD1
FTEXT '003'
FMEND
A132FMT4 FRMT
FMEL '999',GSWBCD1
FTEXT '004'
FMEND
**********
APK KEEP INFORMATION
TBF TTEORFLG,APK00 FIRST FIELD?
CBE SPBINW3,CBIN5,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
SPACES PROC
MOVE GSWBIN1,=W'35'
PERF REPL00,SPINPUT,GSWBIN1
RET
PEND
EJECT
SETKRE PROC
********************
*
* SETKRE - SET KREDIT INFORMATION
*
********************
MOVE GTDBKRC,=C' KRE'
MOVE GTDBKRS,=D'-1'
MOVE TTDKBCD,=D'1'
MOVE TTDKDEX,CBIN1
RET
PEND
*
SETDEB PROC
********************
*
* SETDEB - SET DEBET INFORMATION
*
********************
MOVE GTDBKRC,=C' DEB'
MOVE GTDBKRS,=D'+1'
MOVE TTDKBCD,=D'2'
MOVE TTDKDEX,CBIN2
RET
PEND
EJECT
SELTR PROC
********************
*
* SELTR - PROCEDURE TO SEE IF TRANSTYPE HAS BEEN
* SELECTED.
* SELECTED TRANSTYPE IS IN SPBINW5
*
********************
CBE SPBINW2,CBIN3,SELOK ENTER KEY
CBE SPBINW2,CBIN18,SEL10 KREDIT KEY
CBE SPBINW2,CBIN17,SEL20 DEBET KEY
MOVE SPBINW4,CBIN4 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,CBIN19 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
EJECT
YYMMDD PROC P
**********
* YYMMDD CHECKS THAT THE DATE IS IN FOR FORMAT YYMMDD.
* IF NOT, IT WILL BE INVERTED
* OUTPUT IN GSWBCD7
**********
MOVE GSWBCD7,P
CBG P,=D'800000',YYMM90
MOVE GSWBCD6,P
XCOPY GSWBCD7,CBIN6,CBIN1,GSWBCD6,CBIN4
XCOPY GSWBCD7,CBIN4,CBIN1,GSWBCD6,CBIN6
YYMM90
RET
PEND
CHDATO PROC
**********
* CHANGES GSWBCD6 (DDMMYY) TO
* GSWBCD7 (YYMMDD)
**********
MOVE GSWBCD7,GSWBCD6
XCOPY GSWBCD7,CBIN6,CBIN1,GSWBCD6,CBIN4
XCOPY GSWBCD7,CBIN4,CBIN1,GSWBCD6,CBIN6
RET
PEND
*
XCOP PROC TO,$TOPNT,$SIZE,FROM,$FROMPNT
PLIT $TOPNT
PLIT $SIZE
PLIT $FROMPNT
MOVE GSWBIN1,$TOPNT START OF RECEIVING FIELD
MOVE GSWBIN4,$SIZE LENGTH
MOVE GSWBIN5,$FROMPNT START OF SENDING FIELD
XCOPY TO,GSWBIN1,GSWBIN4,FROM,GSWBIN5
RET
PEND
END