|
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: 13998 (0x36ae)
Notes: pts_type(SC)
Names: »RGSUBS.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/RGSUBS.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/RGSUBS.SC«
IDENT RGSUBS 831031 EV
DDUM KMD08
PDIV
ENTRY ENTER
ENTRY MODP
ENTRY KVIT
ENTRY LSTINT
ENTRY SUBTOT
ENTRY SUM
ENTRY DIVTR
EXT SETKRE
EXT SETDEB
EXT SLUT
EXT KORT
EXT CYCLR
EXT FRMTKV
EXT FRMXSP
EXT FRMTSP
EXT FRMXVO
EXT FRMXTA
EXT WRITVO
EXT WRITJT
EXT WRITLO
EXT WTALLY
EXT WCHECK
EXT LINOPT
EXT CRVO
EXT SPINF1
EXT SPLIN8
EXT GRASPV
EXT FLDTST
EXT CYOUT
EXT RAWRIT
INCLUDE EQUATE
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)
CLEAR GTLOKSPG
MOVE SPKEY,CBIN1
SET TTINVFLG
MUL GTDUPF(CBIN4),='-1' MULTIPLY BELOB BY -1
* SET BCPR/BLEV ACCORDING TO THE CONTENTS OF GTDUPF(2)
SET BCPR
CBL GTDUPF(CBIN2),=D'10000000',MODP10
SET BLEV
CBG GTDUPF(CBIN2),=D'3900000000',MODP20
CLEAR BLEV
B MODP20
MODP10
CLEAR BCPR
MODP20
PERF SLUT
CLEAR TTINVFLG
CLEAR BCPR
CLEAR BLEV
CBNE GTRETUR,CBIN3,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)
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 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
TBT GTSLUTFL,ENTY1
* AFTER PAGE 1, GET NEXT PAGE
PERF FMTNXT,CBIN2
MOVE GTRETUR,=W'2'
B ENTOK
*
ENT20
CBNE GTPAGE,CBIN2,ENT30
TBT GTSLUTFL,ENT30
* AFTER PAGE 2, GET LAST PAGE
PERF FMTNXT,CBIN3
MOVE GTRETUR,=W'2'
B ENTOK
ENT30
B ENT10
ENT40
* CORRECT PAGE 3
PERF SLUT
BNOK ENTNOK
CLEAR GTKORTFL
CBE GTSUM,=D'0',ENT50
MOVE GTPAGE,CBIN4
MOVE GTRETUR,=W'1'
B ENTWC
ENT50
* FINISHED
MOVE GTRETUR,=W'3'
ENTWC
PERF WCHECK,CBIN1
BNOK ENTNOK
ENT60
PERF FRMTSP FULL FORMAT
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)
*
****-**************
MOVE GSWBIN1,FORMAL1 WHICH PAGE?
IB GSWBIN1,NXTATT,NXT20,NXT30
NXT20
MOVE GTPAGE,CBIN2
CBE GTREGDEX,CBIN8,NXT208
CBE GTREGDEX,CBIN9,NXT209
CBE GTREGDEX,=W'24',NXT251
B NXT253
NXT208
MOVE GSWBIN1,CBIN7
B NXTATT
NXT209
MOVE GSWBIN1,CBIN8
B NXTATT
NXT251
MOVE GSWBIN1,CBIN3
B NXTATT
NXT253
MOVE GSWBIN1,CBIN4
B NXTATT
NXT30
MOVE GTPAGE,CBIN3
CBE GTREGDEX,CBIN8,NXT308
CBE GTREGDEX,CBIN9,NXT309
CBE GTREGDEX,=W'24',NXT351
B NXT353
NXT308
MOVE GSWBIN1,CBIN1
B NXTATT
NXT309
MOVE GSWBIN1,CBIN2
B NXTATT
NXT351
MOVE GSWBIN1,CBIN5
B NXTATT
NXT353
MOVE GSWBIN1,CBIN6
NXTATT
PERF FRMXSP,GSWBIN1
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,CBIN0
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,GTUWB 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
MOVE GSWBIN1,=W'28'
PERF WRITLO,GSWBIN1
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
PERF WRITJT,=W'4' WRITE SLUT SUM FUNCTION
MOVE GSWBIN1,=W'29'
PERF WRITLO,GSWBIN1
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 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