|
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: 23664 (0x5c70)
Notes: pts_type(SC)
Names: »RGSUBS.SC«
└─⟦38a30a456⟧ Bits:30009662 Philips computer tape "600104"
└─⟦this⟧ »OD-KOM/RGSUBS.SC«
IDENT RGSUBS 840124 EV
DDUM KMD08
PDIV
ENTRY ENTER
ENTRY MODP
ENTRY KORT
ENTRY KKTRP
ENTRY KVIT
ENTRY LSTINT
ENTRY CYKINT
ENTRY CYK
ENTRY CYCLR
ENTRY SUBTOT
ENTRY SUM
EXT ADM
ENTRY DIVTR
ENTRY KKCH
ENTRY FMTNXT
EXT SETKRE
EXT SETDEB
EXT SLUT
EXT FRMTVO
EXT FRMTKV
EXT FRMXJT
EXT FRMXSP
EXT FRMXVO
EXT FRMXTA
EXT FRMTKT
EXT FRMXKT
EXT WRITVO
EXT WRITJT
EXT WTALLY
EXT WCHECK
EXT LINOPT
EXT ABORT
EXT EMPTYT
EXT CRVO
EXT SPCLRA
EXT SPERR
EXT SPINF1
EXT SPLIN8
EXT GRASPV
EXT CLEAR8
EXT SPCHK5
EXT FLDTST
EXT CYOUT
EXT CYTRP
EXT WRITLO
INCLUDE EQUATE
EJECT
KORT PROC
********************
*
** KORT - PROCEDURE FOR WRITING ON 'KONTOKORT
*
** KASSEFUNCTION OLY (TRANS 1-4, 6, 8-12)
******************
TBF TTEORFLG,KORTNOK NOT CORRECT TRANS
TBT GTREGFLG,KORTNOK MUST NOT BE FIRST TRANS
TBF GTKASSE,KORTNOK ONLY IN KASSEFUNCTIONS(1-12)
CBE GTREGNR,=D'5',KORTNOK NOT TRANS 5
CBE GTREGNR,=D'7',KORTNOK NOT TRANS 7
** ASK FOR OLD SALDO, LINE NO AND LINE CHECKDIGIT
** WRITE 'KONTOKORT' ON JOURNAL
** TRANSPORT LINE IF NEEDED
*
KORT10
MOVE SPKEY,CBIN1
CLEAR GTSLDFLG
TBF CKTFLAG,KORT12
SET TTKORTFL
KORT12
PERF FRMXSP,CBIN12 SALDO/LINE/CHECK
SET SPPROMPT
PERF SPCLRA WRITE/READ ON SCREEN
CLEAR SPPROMPT
IB SPBINW2,KORTOK,KORTOK,KORT30
KORT20 ERRORKEY
MOVE SPBINW4,=W'4'
PERF SPERR
B KORT10
KORT30 CORRECT ENTERED
TBF CKTFLAG,KORT40 NO SALDO
SET GTSLDFLG
CALL EMPTYT,TTKTSLD GL SALDO PRESENT?
BE KORT40 YES
CLEAR GTSLDFLG NOT PRESENT
TBF CSLDFLG,KORT40 ALLOWED
MOVE SPBINW4,=W'5' NOT ALLOWED
PERF SPERR
B KORT10
KORT40
PERF WRITJT,=W'2' 'KONTOKORT' ON JOURNAL
PERF WRITLO,CBIN2
PERF KKTRP TRANSPORT LINE IF NEEDED
MOVE SPINPUT,TTKTLIN
PERF SPCHK5 GET THE OLD LINE NUMBER
CBG GSWBIN1,=W'89',KORT20
DSC1 KVOUCH,POS,GSWBIN1 POS ON LINE
ADD TTKTSLD,GTDUPF(CBIN4) NEW SALDO
ADD TTKTLIN,=D'1' ADD 1 TO LINE NO
PERF KKCH NEW CHECKDIGIT
PERF FRMTKT
EDWRT KVOUCH,GTSTRFMT
DSC0 .NW,KVOUCH,RLEAS
CLEAR GTLOKSPG
KORTOK
CLEAR TTKORTFL
CMP CBIN0,CBIN0 OK, SET CR=0
RET
KORTNOK
CLEAR TTKORTFL
CMP CBIN1,CBIN0 NOK, SET CR <>0
RET
PEND
EJECT
KKTRP PROC
********************
*
** KKTRP - WRITES KONTOKORT INF ON VOUCHER
** + TRANSPORT IF NECESSARY
*
********************
PERF SPLIN8,CBIN6,CBIN2 WRITE KONTOKORT
TBF GTCYFLG,KON20 IF IN CYCLE
TBF GTCYWRTF,KON20
DSC0 KVOUCH,RLEAS
CLEAR TTTSTFLG
KON20
PERF GRASPV GRASP VOUCHER
PERF CLEAR8
TBF CKTFLAG,KON90
TBF GTSLDFLG,KON90 NO SALDO
CBNE TTKTLIN,=D'27',KON90 TRANSPORT LINE?
PERF FRMXKT,CBIN1 GET TRANSPORT LINE
DSC1 KVOUCH,POS,CMINLIN
EDWRT .NW,KVOUCH,GTSTRFMT EDWRT TRP. LINE
KON30
PERF SPLIN8,CBIN3,CBIN0 'NY SIDE'
WAIT KVOUCH
DSC0 KVOUCH,RLEAS
PERF GRASPV
TESTIO KEYB ANY INPUT?
BOK KON35 YES
CALL ABORT,KEYB NO, ABORT
DSC0 KEYB,SKIB DELETE CYCLIC INPUT BUFFER
MOVE GSWBCD3,CKTTOP SET DEFAULT LINE
MOVE SPINPUT,GSWBCD3
B KON40
KON35
WAIT KEYB
CBE SPBINW2,=W'18',KON40 SLUT KEY
CBNE SPBINW2,=W'4',KON30 ENTER KEY
KON40
MOVE GSWBCD3,SPINPUT GET LINE
MOVE TTKTLIN,GSWBCD3
CBG TTKTLIN,=D'24',KON30 CHECK LINE
CBL TTKTLIN,=D'1',KON30
PERF SPCHK5 CHANGE LINE VALUE
DSC1 KVOUCH,POS,GSWBIN1
PERF FRMXKT,CBIN1
EDWRT KVOUCH,GTSTRFMT
ADD TTKTLIN,=D'1'
KON90
RET
PEND
EJECT
KKCH PROC
********************
*
** KKCH - THIS PROCEDURE COMPUTES A CHECK DIGIT FROM
** AMOUNT (TTKTSLD) AND LINE NR (TTKTLIN) AND
** PUTS IT IN TTKTCHK
** USED FOR KONTOKORT
*
****************
MOVE GSWBCD1,TTKTSLD SAVE
CBNL GSWBCD1,=D'0',KKCH10 NEGATIVE?
MUL GSWBCD1,=D'-1' YES, CHANGE SIGN
KKCH10
MUL GSWBCD1,TTKTLIN MULTIPLY WITH LINE NR
SUB TTKTLIN,=D'1' SUB 1 FROM LINE NR
ADD GSWBCD1,TTKTLIN ADD
ADD TTKTLIN,=D'1' RESTORE LINE NR
MOVE GSWBCD2,GSWBCD1 SAVE
DIV GSWBCD1,=D'7' CALCULATE
MUL GSWBCD1,=D'7' REMAINDER
SUB GSWBCD2,GSWBCD1 MODULUS 7
ADD GSWBCD2,=D'1' ADD 1 ALWAYS
CBL TTKTSLD,=D'0',KKCH20
ADD GSWBCD2,=D'1' ADD 1 IF POSITIVE SALDO
KKCH20
MOVE TTKTCHK,GSWBCD2
RET
PEND
EJECT
MODP PROC
**********
*
** MODP - INVERTS THE PREVIOUS TRANSACTION
** I.E. REVERSES THE VALUE
** AND SETS FLAG TO UPDATE ACCUMULATORS
** MUST NOT BE IN FIRST TRANBS
** ONLY IN KASSEFUNCTIONS
*
**********
TBF TTEORFLG,MODPNOK NOT CORRECT TRANS
MOVE GTRETUR,CBIN0
TBT GTREGFLG,MODPNOK MUST NOT BE FIRST TRANS
TBF GTKASSE,MODPNOK ONLY IN KASSEFUNCTIONS (1-12)
TBT GTSPECTR,MODPNOK NOT TR 50...
PERF CYTRP
CLEAR GTLOKSPG
MOVE SPKEY,CBIN1
SET TTINVFLG
MUL GTDUPF(CBIN4),='-1' MULTIPLY BELOB BY -1
PERF SLUT
CLEAR TTINVFLG
CBNE GTRETUR,=W'3',MODP50
PERF KORT
MODP50
CMP CBIN0,CBIN0 OK, SET CR=0
RET
MODPNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
PEND
EJECT
KVIT PROC
**********
*
** KVIT - WRITES AN EXTRA RECEIPT
** ONLY IN KASSEFUNCTIONS
*
**********
TBF TTEORFLG,KVITNOK NOT CORRECT TRANS
TBT GTREGFLG,KVITNOK MUST NOT BE FIRST TRANS
TBT GTCYFLG,KVITNOK NOT IN CYCLE
TBF GTKASSE,KVITNOK ONLY IN KASSEFUNCTIONS(1-12)
TBT GTSPECTR,KVITNOK NOT TR50...
MOVE SPKEY,CBIN1
PERF WRITJT,=W'1' WRITE 'KVIT' ON JOURNAL
PERF WRITLO,CBIN1
MOVE TTCYM,=C'K'
PERF FRMTKV
PERF WRITVO WRITE RECEIPT
MOVE TTCYM,=C' '
CLEAR GTLOKSPG
CMP CBIN0,CBIN0 OK, SET CR =0
RET
KVITNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
PEND
EJECT
ENTER PROC
**********
*
** ENTER - PERFORMS DIFFERENT CHECKS AFTER A PAGE HAS BEEN
** ENTERED ON SCREEN
*
** 1 ANY PAGE TWO ?
*
** 2 FOR TRANSTYPE 51,53, REPETITION OF PAGE 3 ?
*
** 3 FIELD DEPENDENCE TEST
*
** AND THEN PERFORM PROCEDURE SLUT, TO
** WRITE TO DISK AND WRITE RELEVANT RECEIPTS
*
**********
MOVE GTRETUR,CBIN0 SET RETURN CODE
TBT GTTYPE3,ENTY3
TBT GTTYPE2,ENTY2
* TYPE 1 - ONE PAGE TRANSACTION
ENTY1
PERF FLDTST TEST FIELD DEPENDENCE
BNOK ENTNOK
PERF SLUT OK
BNOK ENTNOK
TBT GTKORTFL,ENT01
CBE GTRETUR,=W'3',ENT01 IF LINE 91
MOVE GTRETUR,=W'1'
TBF CKTAUTO,ENTOK
CBNE GTREGDEX,=W'4',ENTOK
ENT01
PERF KORT TRANS 4: KONTOKORT
MOVE GTRETUR,=W'3' RESET SCREEN
CLEAR GTKORTFL
B ENTOK
* TYPE 2 - TWO PAGE TRANSACTION
ENTY2
CBNE GTPAGE,CBIN1,ENT10
* GET PAGE 2
TBT GTSLUTFL,ENTY1
SET GTSLUTFL
PERF FMTNXT,CBIN1
MOVE GTPAGE,CBIN2
MOVE GTRETUR,=W'2'
B ENTOK
*
ENT10
PERF FLDTST
BNOK ENTNOK
PERF SLUT
BNOK ENTNOK
TBT GTKORTFL,ENT01
CBE GTRETUR,=W'3',ENT01
MOVE GTRETUR,=W'3'
B ENTOK
* TYPE 3 - THREE PAGE TRANSACTION
ENTY3
CBNE GTPAGE,CBIN1,ENT20
* AFTER PAGE 1, GET NEXT PAGE
PERF FMTNXT,CBIN2
MOVE GTPAGE,CBIN2
MOVE GTRETUR,=W'2'
B ENTOK
*
ENT20
CBNE GTPAGE,CBIN2,ENT30
* AFTER PAGE 2, GET LAST PAGE
PERF FMTNXT,CBIN3
MOVE GTPAGE,CBIN3
MOVE GTRETUR,=W'2'
B ENTOK
*
ENT30
CBNE GTPAGE,CBIN3,ENT40
* FIRST TIME PAGE 3
PERF FLDTST
BNOK ENTNOK
B ENT40
*
ENT40
* CORRECT PAGE 3
PERF SLUT
BNOK ENTNOK
CLEAR GTKORTFL
CBE GTSUM,=D'0',ENT50
MOVE GTPAGE,CBIN4
MOVE GTRETUR,=W'1'
B ENTOK
*
ENT50
* FINISHED
MOVE GTRETUR,=W'3'
*
ENTOK
CMP CBIN0,CBIN0 OK, SET CR =0
RET
ENTNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
*
PEND
EJECT
FMTNXT PROC FORMAL1
*******************
*
** FMTNXT - ATTACHES FORMATS FOR PAGE 2 AND 3
** TRANSTYPES 8,9,51 AND 53
** (DEX 8,9,21,23)
*
****-**************
CBNE FORMAL1,CBIN1,NXT10 INDEX 1:
MOVE GSWBIN1,CBIN1 TYPE 8
CBE GTREGDEX,=W'8',NXT10
MOVE GSWBIN1,CBIN2 TYPE 9
CBE GTREGDEX,=W'9',NXT10
MOVE GSWBIN1,CBIN3 TYPE 51
CBE GTREGDEX,=W'21',NXT10
MOVE GSWBIN1,CBIN4 TYPE 53
NXT10
CBE FORMAL1,CBIN1,NXTATT INDEX 2:
CBNE FORMAL1,CBIN2,NXT20
MOVE GSWBIN1,CBIN3 TYPE 51,PAGE 2
CBE GTREGDEX,=W'21',NXT20
MOVE GSWBIN1,CBIN4 TYPE 53,PAGE 2
NXT20
CBNE FORMAL1,CBIN3,NXTATT INDEX 3:
MOVE GSWBIN1,CBIN5 TYPE 51,PAGE 3
CBE GTREGDEX,=W'21',NXTATT
MOVE GSWBIN1,CBIN6 TYPE 53,PAGE 3
NXTATT
PERF FRMXSP,GSWBIN1
RET
PEND
EJECT
CYK PROC CYTYPE
********************
*
* HANDLE DIFFERENT TYPES OF CYCLES
*
********************
TBT GTSPECTR,CYKNOK NOT TR50...
IB CYTYPE, C
CYK1,CYK2,CYKNOK,CYK4,CYKNOK, C
CYKNOK,CYKNOK,CYKNOK,CYK9,CYEND
B CYKNOK
EJECT
CYK1
********************
*
** CYK1 - START OF CYCLE FUNCTION
*
********************
TBT TTLSTFLG,CYK1NOK IN LISTE
TBT TTCY2FLG,CYK1NOK IN CYCLE 2
SET TTCY1FLG
MOVE TTCYM,=C'C' FOR JOURNAL
MOVE GTTEXT,=C'CYKLE ' FOR SCREEN
PERF CYKINT
B CYKOK
CYK1NOK
B CYKNOK
EJECT
CYK2
********************
*
** CYK2 - START OF STABEL FUNCTION
*
********************
TBT TTLSTFLG,CYK2NOK IN LISTE
TBT TTCY1FLG,CYK2NOK IN CYCLE 1
SET TTCY2FLG
MOVE TTCYM,=C'S' FOR JOURNAL
MOVE GTTEXT,=C'STABEL' FOR SCREEN
PERF CYKINT
B CYKOK
CYK2NOK
B CYKNOK
EJECT
CYK4
********************
*
* CYK4 - PAUSE IN CYCLE / STABEL
*
********************
TBF GTCYFLG,CYK4NOK
TBT GTCYWRTF,CYKSUB
MOVE TTARKSAV,GTDUPF(CBIN9) SAVE ARKIV KNT NR
SET TTPSEFLG INDICATE BREAK
MOVE GTCYSUM,GTSUM
MOVE GTPSELIN,TTLINNR
PERF CYCLR
ERASE 0,CBIN8,CBIN8 ERASE LINE 8
PERF SPINF1
B CYKOK
CYK4NOK
B CYKNOK
CYKSUB
PERF SUBTOT
B CYKOK
EJECT
CYK9
********************
*
** CYK9 - CLEAR ARKIV KONTO NR
*
********************
TBF TTCY1FLG,CYK9NOK
MOVE TTARKSAV,=D'0' CLEAR NUMBER
B CYKOK
CYK9NOK
B CYKNOK
EJECT
CYEND
********************
*
** CYEND - END OF CYCLE
*
** WRITE TOTAL LINE ON VOUCHER
*
********************
TBF GTCYFLG,CYENDNOK ONLY IF IN CYCLE
TBT TTCY2FLG,CYEND10
CBNE GTSUM,=D'0',CYEND30 SUM CORRECT? (ONLY CY1)
CYEND10
CLEAR TTSUMFLG CLEAR FLAGS
CLEAR GTCYFLG
PERF CYOUT
CLEAR TTTSTFLG
WAIT KVOUCH
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER
MOVE GSWSTR9,=C'TOTAL '
PERF FRMXVO,CBIN2 GET TOTAL FORMAT
EDWRT KVOUCH,GTSTRFMT EDWRT ON VOUCHER
DSC0 KVOUCH,RLEAS RELEASE VOUCHER
TBF TSPOOL,CYEND14
TBT CSPOOL,CYEND15
CYEND14
PERF WRITJT,=W'15'
CYEND15
PERF WRITLO,CBIN9
CBL GTREGNR,=D'18',CYEND20 CHECKS?
SET TTTSTFLG
MOVE GTREGF(CBIN4),GTSUM FIND TOTAL VALUE
PERF WCHECK WRITE CHECK
CYEND20
CLEAR TTCY1FLG
CLEAR TTCY2FLG
PERF CYCLR
B CYENDOK
CYEND30
MOVE SPBINW4,=W'12' SET ERRORCODE
PERF SPERR
IB SPBINW2,CYENDCNT,CYEND10
CYENDOK
ERASE 0,CBIN8,CBIN8 ERASE LINE 8
PERF SPINF1
CYENDCNT
B CYKOK
CYENDNOK
B CYKNOK
*
CYKOK
CMP CBIN0,CBIN0 OK
RET
CYKNOK
CMP CBIN1,CBIN0 NOK
RET
PEND
EJECT
CYKINT PROC
********************
*
** CYKINT - START OR END OF CYCLE
*
** START SET RELEVANT INFORMATION AND READ
** ARKIV KNT.NR, KONTROLSUM AND LRER-9
*
** END CLEAR RELEVANT INFORMATION
*
********************
TBF GTCYFLG,CY10 TRUE- ALREADY IN CYCLE
TBT TTPSEFLG,CY05 TRUE- IN PAUSE STATE
PERF CYK,CBIN10
RET
CY05
PERF CYCLR
RET
CY10
SET TTSUMFLG INDICATE SUM ON SCREEN
SET GTCYFLG INDICATE CYCLE
TBF TTPSEFLG,CY30 TRUE- PAUSE STATE
MOVE GTSUM,GTCYSUM GET SAVED SUM
MOVE GTREGF(CBIN9),TTARKSAV GET SAVED ARKIV KNT.NR
CBG GTPSELIN,CBIN0,CY20
MOVE GTPSELIN,TTCYKST RESET START LINE
MOVE TTCYKPOS,TTCYKST
CY20
MOVE TTLINNR,GTPSELIN
CLEAR TTPSEFLG OUT OF PAUSE STATE
B CY90
CY30
MOVE GTREGF(CBIN9),=D'0' INITIATE VALUES
MOVE GTCYSUM,=D'0'
MOVE GTSUM,=D'0'
MOVE TTCYKTOT,=D'0'
MOVE TTLINNR,=D'1'
PERF FRMXSP,CBIN11 GET FORMAT FOR CYCLE INF
SET SPPROMPT
PERF SPCLRA WRITE AND READ ON SCREEN
CLEAR SPPROMPT
IB SPBINW2,CY45,CY45,CY50
CY40 ERROR KEY
MOVE SPBINW4,=W'4'
PERF SPERR
B CY30
CY45 MAK
CLEAR TTCY1FLG
CLEAR TTCY2FLG
B CY05
CY50
CBL TTLINNR,=D'25',CY55
MOVE TTLINNR,=D'1'
CY55
MOVE SPINPUT,TTLINNR
PERF SPCHK5
MOVE TTLINNR,GSWBIN1 FIND LINNE NUMBER
MOVE GTSUM,GTCYSUM
MOVE TTARKSAV,GTREGF(CBIN9)
MOVE TTCYKST,TTLINNR
MOVE TTCYKPOS,TTLINNR
MOVE GTCYIN,TTASKNR
SUB GTCYIN,CBIN1
MUL GTCYIN,CCYSIZE
ADD GTCYIN,CBIN1
MOVE GTCYOUT,GTCYIN
CY90
SET GTCYWRTF
TBT CCYWRTF,CY95
CLEAR GTCYWRTF
CY95
RET
PEND
EJECT
CYCLR PROC
*******************
*
** CYCLR - CLEAR CYCLEINFORMATION
*
******************
MOVE GTTEXT,=C' '
MOVE TTCYM,=C' '
MOVE GTREGF(CBIN9),=D'0'
MOVE GTSUM,=D'0'
CLEAR GTCYFLG
CLEAR TTSUMFLG
CLEAR TTTSTFLG
CLEAR GTCYTRPF
DSC0 KVOUCH,RLEAS RELEASE VOUCHER
RET
PEND
EJECT
LSTINT PROC
********************
*
** LSTINT - INITIATE LISTFUNCTION
*
********************
TBT GTCYFLG,LSTNOK
TBT TTLSTFLG,LSTEND
* FIRST TIME
SET TTSUMFLG
SET TTLSTFLG
MOVE GTSUM,=D'0' INITIATE SUM
PERF FRMXTA,CBIN1 GET HEADER FOR TALLY ROLL
PERF WTALLY WRITE ON TALLY ROLL
MOVE GTTEXT,=C'LISTE '
B LSTOK
* LAST TIME
LSTEND
WAIT KTALLY
MOVE GSWBCD6,GTSUM
MOVE GSWSTR9,=C'TOTAL '
PERF FRMXTA,CBIN2 GET TOTALLINE FOR TALLY
PERF WTALLY
ERASE 0,CBIN8,CBIN8
CLEAR TTLSTFLG
CLEAR TTSUMFLG
MOVE GTTEXT,=C' '
LSTOK
PERF SPINF1
CMP CBIN0,CBIN0 OK, SET CR=0
RET
LSTNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
PEND
EJECT
SUBTOT PROC
*******************
*
** SUBTOT - SUBTOTAL
*
** LISTFUNCTION- WRITE SUBTOTAL ON TALLY
*
** CYCLEFUNCTION- SAVE CYCLE INFORMATION
** WRITE SUBTOTAL
** IN CYCLE-PAUSE-STATE
*
********************
MOVE GSWSTR9,=C'SUBTOTAL '
TBT TTLSTFLG,SUBTLST IN LIST FUNCTION
TBT GTCYFLG,SUBTCYC IN CYCLE
TBF GTSUMKEY,SUBTNOK IN SUM
* SUBTOTAL IN SUM
SET GTSUBFLG
PERF SUM
CLEAR GTSUBFLG
B SUBTOK10
* SET PAUSE IN CYCLE
SUBTCYC
PERF CYOUT
MOVE TTARKSAV,GTDUPF(CBIN9) SAVE ARKIV KNT NR
SET TTPSEFLG INDICATE BREAK
PERF FRMXVO,CBIN3 GET SUBTOT FORMAT
SET GTCYWRTF
PERF WRITVO WRITE SUBTOT LINE
WAIT KVOUCH
DSC0 KVOUCH,RLEAS RELEASE VOUCHER
MOVE GTCYSUM,GTSUM SAVE SUM
SUB TTLINNR,=D'4'
MOVE TTCYKPOS,TTLINNR SAVE LINNR
MOVE GTPSELIN,TTLINNR
MOVE GTCYIN,TTASKNR INITIATE CYSET
SUB GTCYIN,CBIN1
MUL GTCYIN,CCYSIZE
ADD GTCYIN,CBIN1
MOVE GTCYOUT,GTCYIN
PERF CYCLR
B SUBTOK
* SUBTOTAL IN LIST
SUBTLST
WAIT KTALLY
MOVE GSWBCD6,GTSUM
PERF FRMXTA,CBIN3 GET FORMAT
PERF WTALLY WRITE ON TALLY ROLL
SUBTOK
ERASE 0,CBIN8,CBIN8 ERASE LINE 8
PERF SPINF1
SUBTOK10
CMP CBIN0,CBIN0 OK, SET CR=0
RET
SUBTNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
PEND
EJECT
SUM PROC
********************
*
** SUM - PROCEDURE FOR SUMMING UP FOR ALL
** TRANSACTIONS FROM THE INITIATING
** POINT TO THE RELEASING.
** FIRST TIME: INITIATING
** LAST TIME: WRITE SUM ON VOUCHER
*
********************
TBT GTSUMKEY,SUM50
* FIRST TIME
PERF WRITJT,=W'3' WRITE START SUM FUNCTION
PERF WRITLO,CBIN10
SUM10
MOVE TTSUMMRK,=C'*'
SET GTSUMKEY
MOVE GTSUMST,TTLBNR
ADD GTSUMST,=D'1' INITIATE FIRST NUMBER
MOVE GTSUMCNT,=D'0' INITIATE SUM
B SUMOK
*
* LAST TIME
SUM50
MOVE GSWSTR9,=C'TOTAL '
TBF GTSUBFLG,SUM55
MOVE GSWSTR9,=C'SUBTOTAL '
SUM55
PERF WRITJT,=W'4' WRITE SLUT SUM FUNCTION
PERF WRITLO,CBIN11
TBT GTSUBFLG,SUM60
MOVE TTSUMMRK,=C' '
CLEAR GTSUMKEY
SUM60
PERF SPLIN8,CBIN2,CBIN0 WRITE BILAG
TBF GTCYFLG,SUM70 IF IN CYCLE
DSC0 KVOUCH,RLEAS
MOVE GSWBCD5,TTLINNR SAVE LINNR
CLEAR TTTSTFLG
SUM70
PERF GRASPV
CLEAR GTSWFLAG
PERF LINOPT
BNOK SUM60
CBG GSWBIN1,=W'90',SUM75
CBNE GSWBIN1,=W'0',SUM80 DEFAULT LINE?
SUM75
MOVE TTLINNR,=D'6' SET LINE 26
SUM80
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1
MOVE TTLINNR,GSWBCD5 RESTORE LINNR
PERF FRMXVO,CBIN7
EDWRT KVOUCH,GTSTRFMT
PERF CRVO
DSC0 .NW,KVOUCH,RLEAS
TBT GTSUBFLG,SUMOK10
TBT GTASUMFL,SUM10
SUMOK
PERF SPINF1
SUMOK10
CMP CBIN0,CBIN0 OK, SET CR=0
RET
PEND
EJECT
DIVTR PROC
********************
*
** DIVTR - SET OR CLEAR DIVTR FLAG
*
********************
TBT CTRVALG,DIVTRNOK
TBT GTSPECTR,DIVTRNOK NOT ALLOWED, TR50...
TBT GTDIVTR,DIVEND
* SET DIVTR
SET GTDIVTR
SET GTTRSEL
CBE TTDKDEX,=W'1',DIV10
PERF SETDEB
B DIVTROK
DIV10
PERF SETKRE
B DIVTROK
* CLEAR DIVTR
DIVEND
CLEAR GTDIVTR
MOVE TTSTYRDX,=W'1'
B DIVTROK
*
DIVTROK
CMP CBIN0,CBIN0 OK, SET CR=0
RET
DIVTRNOK
CMP CBIN1,CBIN0 NOK, SET CR<>0
RET
PEND
*
*
END