|
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: 20476 (0x4ffc)
Notes: pts_type(SC)
Names: »KMDIO.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/KMDIO.SC«
IDENT KMDIO 820527 NJ
DDUM KMD08
PDIV
ENTRY WRITFD
ENTRY WRITVO
ENTRY WRITJT
ENTRY WTALLY
ENTRY WRITID
ENTRY CRKJ
ENTRY GRASPV
ENTRY LINOPT
ENTRY CRVO
EXT WCHECK
ENTRY WCHUPD
EXT CLEAR8
EXT RADEL
EXT SPCHK5
EXT SPLIN8
EXT SPERR
EXT FRMTJT
EXT FRMXJT
EXT ADM
EXT CYWRT
EXT FRMXVO
EXT FRMXTA
EXT ABORT
EXT RAWRIT
EXT YYMMDD
EXT WAITF
INCLUDE EQUATE
EJECT
WRITFD PROC
TBF CSKIFTWN,WRFD00
PERF ADM,CBIN12 DISKETTE SKIFT
TBF CSKIFTWN,WRFD00
CMP CBIN1,CBIN0
RET
WRFD00
PERF WAITF,CPFLG
MOVE GSWBIN3,GTREGDEX
SUB GSWBIN3,CBIN11
IB GSWBIN3,WRFD001,WRFD002,WRFD001,WRFD002
B WRFD003
WRFD001
MOVE GTREGNR,=D'1' TRANS 18,28 -> TRANS 1
B WRFD003
WRFD002
MOVE GTREGNR,=D'6' TRANS 19,29 -> TRANS 6
WRFD003
CLEAR CSPLITFL
MOVE CTWBIN1,CBIN0 NO. OF WRITTEN RECORDS
PERF EDATNR
MOVE GSWBIN5,CBIN0
WRFD005
SET CSWFLAG
CBE CRECLGD,=W'128',WRFD006
CLEAR CSWFLAG
WRFD006
EDIT CPCKBUF,PCKINIT
EDIT CPCKBUF,TREC1 INSERT HEADER INF
* RESET GTREGNR
MOVE GTREGNR,CREGTAB(GTREGDEX,CBIN1)
MOVE GSWBIN3,CBIN10
MOVE GSWBIN4,CRECLGD
SUB GSWBIN4,CBIN11
MATCH CPCKBUF,GSWBIN3,GSWBIN4,CBLANKS,CBIN0,CBIN2
MOVE GSWBIN4,CRECLGD
SUB GSWBIN4,CBIN1
SUB GSWBIN4,GSWBIN3 REMAINING LENGTH
CBE GTREGNR,=D'12',WRFD070
TBT CSPLITFL,WRFD025 IF SPLIT PACK REST
WRFD020
ADD GSWBIN5,CBIN1
CBNL GSWBIN5,CBINMAX,WRFD070
CBE GTUSED(GSWBIN5),CBIN0,WRFD020 USED FIELD ?
CBE GTUSED(GSWBIN5),=W'90',WRFD090
CBE GTUSED(GSWBIN5),=W'91',WRFD091
CBE GTUSED(GSWBIN5),=W'92',WRFD092
CBE GTUSED(GSWBIN5),=W'93',WRFD093
CBE GTUSED(GSWBIN5),=W'94',WRFD094
MOVE SPINPUT,=X'00' YES
MOVE GSWBCD3,GTUSED(GSWBIN5) CONVERT
EDIT SPINPUT,PFRM1
WRFD025
MOVE GSWSTR1,=X'00'
MOVE GSWBIN6,CBIN0 FIND LENGTH
MOVE GSWBIN10,=W'30'
MATCH SPINPUT,GSWBIN6,GSWBIN10,GSWSTR1,CBIN0,CBIN1
CLEAR CSPLITFL
CBG GSWBIN6,GSWBIN4,WRFD030 OVERFLOW ?
COPY CPCKBUF,GSWBIN3,GSWBIN6,SPINPUT,CBIN0 NO
ADD GSWBIN3,GSWBIN6
SUB GSWBIN4,GSWBIN6 ADJUST POINTERS
B WRFD020 SEE IF MORE
WRFD030
COPY CPCKBUF,GSWBIN3,GSWBIN4,SPINPUT,CBIN0
MOVE GSWSTR1,=X'21' CONTINUATION MARK
ADD GSWBIN3,GSWBIN4
COPY CPCKBUF,GSWBIN3,CBIN1,GSWSTR1,CBIN0
DLETE SPINPUT,CBIN0,GSWBIN4
SET CSPLITFL
PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR
BNOK WRFDERR
TBT GTTESTFL,WRFD005
ADD CTWBIN1,CBIN1
ADD CRECNR,CBIN1
ADD CRECBCD,=D'1'
B WRFD005 GO AND PACK REST
WRFD070
MOVE GSWSTR1,=X'7F'
COPY CPCKBUF,GSWBIN3,CBIN1,GSWSTR1,CBIN0
PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR
BNOK WRFDERR
TBT GTTESTFL,WRFD080
ADD CTWBIN1,CBIN1
ADD CRECNR,CBIN1
ADD CRECBCD,=D'1'
PERF RADEL,DK02,CRECNR
BNOK WRFDERR
*
* LOOK FOR ACCOUNT NO
* IN KONTOPLAN. IF FOUND,
* SET FLAG GTKORTFL
*
CBL CRECNR,CMAXREC,WRFD080
CLEAR CPFLG
CLEAR CSPLITFL
MOVE SPBINW4,CBIN21
MOVE GTWBCD2,=D'2' FILE CODE
MOVE GTWBCD1,=D'50' ERROR CODE
MOVE GSWSTR9,=C'DISCFEJL '
PERF SPERR
CMP CBIN0,CBIN0
RET
WRFD090
MOVE SPINPUT,=X'26393000'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN1),CBIN0
B WRFD095
WRFD091
MOVE SPINPUT,=X'26393100'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN2),CBIN0
B WRFD095
WRFD092
MOVE SPINPUT,=X'26393200'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN3),CBIN0
B WRFD095
WRFD093
MOVE SPINPUT,=X'26393300'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN4),CBIN0
B WRFD095
WRFD094
MOVE SPINPUT,=X'26393400'
XCOPY SPINPUT,CBIN3,CBIN22,GTFELT90(CBIN5),CBIN0
WRFD095
B WRFD025
*
WRFD080
CLEAR CSPLITFL
CLEAR CPFLG
CMP CBIN0,CBIN0 OK, SET CR=0
RET
*
WRFDERR
*
* HERE MUST BEE RECOVERRY
SUB CRECNR,CTWBIN1
MOVE GSWBCD1,CTWBIN1
SUB CRECBCD,GSWBCD1
SET CSKIFTWN
CLEAR CPFLG
SET GTREGFLG
CMP CBIN1,CBIN0 NOK, CR<>0
RET
PEND
EJECT
********************************************
*
* EDATNR
* FINDS DATASETNR FOR THE TRANSACTIONS
* AND PUT THE INFORMATION IN RELEVANT FIELDS
*
************************************************
EDATNR PROC
CLEAR TTR11FLG
CBG GTREGNR,=D'12',EDAT100
MOVE CEDATNR,=D'1'
CBG GTREGNR,=D'10',EDAT010
MOVE GTUSED(CBIN5),CBIN9 UPDATE D/K MARK
MOVE GTDUPF(CBIN5),TTDKBCD
EDAT010
CBNE GTREGNR,=D'11',EDAT020
SET TTR11FLG
EDAT020
RET
EDAT100
CBG GTREGNR,=D'42',EDAT110
MOVE CEDATNR,=D'3' TR 40-42
B EDAT020
EDAT110
CBG GTREGNR,=D'47',EDAT120
MOVE CEDATNR,=D'5' TR 45-47
B EDAT020
EDAT120
CBG GTREGNR,=D'49',EDAT130
MOVE CEDATNR,=D'4' TR 48-49
B EDAT020
EDAT130
MOVE CEDATNR,=D'2' TR 50-54
B EDAT020
PEND
EJECT
WCHUPD PROC
* THE PROCEDURE UPDATES VAR.INFO ON LEV,
* AFTER A TRANS 18,19,28 OR 29
TBT TTREST,WCHUPD15
PERF YYMMDD,GTDATO
MOVE GTREGF(CBIN10),GSWBCD7 UDB.DATO
MOVE GTREGF(CBIN11),GTDUPF(CBIN4) UDB. BELOB
ADD GTREGF(CBIN12),GTDUPF(CBIN4) UDB ]TD
TBF GTBDTFLG,WCHUPD16
CBL GTDUPF(CBIN4),=D'0',WCHUPD12
ADD GTREGF(CBIN14),GTDUPF(CBIN4) VENT DEBET
B WCHUPD14
WCHUPD12
ADD GTREGF(CBIN15),GTDUPF(CBIN4) VENT KREDIT
WCHUPD14
ADD GTREGF(CBIN16),GTDUPF(CBIN4) SKYLDIGT BELOB
WCHUPD15
MOVE GSWBCD6,GTREGF(CBIN13) GET LOW VALORDATE
PERF YYMMDD,GSWBCD6
MOVE GTREGF(CBIN13),GSWBCD7
MOVE GSWBCD6,GTDUPF(CBIN7)
PERF YYMMDD,GSWBCD6
CBG GSWBCD7,GTREGF(CBIN13),WCHUPD16 NEW LOW?
MOVE GTREGF(CBIN13),GTDUPF(CBIN7) YES
WCHUPD16
RET
PEND
EJECT
WRITJT PROC $JTLIT
PLIT $JTLIT
********************
*
* THIS ROUTINE MAKES OUTPUT ON JOURNAL TAPE
* DEPENDING ON TRANSACTION TYPE
*
********************
WAIT KVOUCH
WAIT KTALLY
TBT GTSPGFLG,JTRET
MOVE GSWBIN1,$JTLIT
CBG GSWBIN1,CBIN0,JT10
PERF FRMTJT GET FORMAT ACORDING TO TYPE
B JT20
JT10 PERF FRMXJT,GSWBIN1 GET SPECIAL FORMAT
JT20
MOVE GSWBIN1,TTCNTNR 'TAELLER' NR IN BINARY
TBT GTNWFLG,JT50
EDWRT KJTAPE,GTSTRFMT EDWRT JOURNAL
JT30
CBL GTREGDEX,CBIN8,JT35
CBG GTREGDEX,CBIN9,JT35
MOVE GSWBIN1,$JTLIT
CBG GSWBIN1,CBIN0,JT35
CBNE GTUSED(CBIN20),=W'90',JT31
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN1),CBIN0
WRITE KJTAPE,SPINPUT
JT31
CBNE GTUSED(CBIN21),=W'91',JT32
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN2),CBIN0
WRITE KJTAPE,SPINPUT
JT32
CBNE GTUSED(CBIN22),=W'92',JT33
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN3),CBIN0
WRITE KJTAPE,SPINPUT
JT33
MOVE GSWBIN1,=W'23'
CBNE GTUSED(GSWBIN1),=W'93',JT34
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN4),CBIN0
WRITE KJTAPE,SPINPUT
JT34
MOVE GSWBIN1,=W'24'
CBNE GTUSED(GSWBIN1),=W'94',JT35
MOVE SPINPUT,=X'00'
XCOPY SPINPUT,CBIN13,CBIN22,GTFELT90(CBIN5),CBIN0
WRITE KJTAPE,SPINPUT
JT35
*
DSC0 KJTAPE,TSTAT TEST STATUS OF JOURNAL
BOK JTRET
PERF SPLIN8,CBIN1,CBIN1 'SKIFT JOURNAL'
SET TTJTEND
JTRET
RET
JT50
EDWRT .NW,KJTAPE,GTSTRFMT
RET
PEND
EJECT
WTALLY PROC
*******************
* WRITE TALLY ROLL
********************
WAIT KVOUCH
WAIT KTALLY
EDWRT .NW,KTALLY,GTSTRFMT EDWRT WITH THE FORMAT
RET STORED IN GTSTRFMT
PEND
CRKJ PROC
********************
* DOES A CARRIAGE RETURN ON TTP WITHOUT WAIT
********************
EDWRT .NW,KJTAPE,CRJTFMT
RET
CRJTFMT FRMT
FILLR ' ',2
FILLR X'0D',1
FMEND
PEND
CRVO PROC
*******************
* DOES A CARRIAGE RETURN ON VOUCHER WITH WAIT
********************
EDWRT KVOUCH,CRVOFMT
RET
CRVOFMT FRMT
FILLR ' ',2
FILLR X'09',1
FMEND
PEND
EJECT
WRITVO PROC
*
* WRITE VOUCHER
*
* IN CYCLE POSITION AND WRITE
* (MAY BE NEW PAGE)
*
* NOT CYCLE GET LINE NR
* POSITION VOUCHER
* WRITE
* AND RELEASE VOUCHER
*
********************
TBT GTCYFLG,CYVOUCH
* NOT IN CYCLE
WOBILAG
PERF SPLIN8,CBIN2,CBIN0 WRITE BILAG
PERF GRASPV
CLEAR GTSWFLAG
PERF LINOPT SEE IF DEFAULT LINE
BNOK WOBILAG
CBG GSWBIN1,=W'90',WO90
MOVE GSWBIN1,TTLINNR
B WO100
WO90 MOVE GSWBIN2,=W'100'
SUB GSWBIN2,GSWBIN1
IB GSWBIN2, C
WO99,WO98,WO97,WO96,WO95, C
WO94,WO93,WO92,WO91
WO99
PERF FRMXVO,CBIN6
MOVE GSWBIN1,=W'35'
B WO100
WO98
PERF FRMXVO,CBIN4
MOVE GSWBIN1,CBIN14
B WO100
WO97
PERF FRMXVO,CBIN5
MOVE GSWBIN1,CBIN14
B WO100
WO96
PERF FRMXVO,CBIN17
MOVE GSWBIN1,=W'37'
B WO100
WO95
WO94
WO93
DSC0 KVOUCH,RLEAS
B WOBILAG
WO92 SHORT 'BILAG'
PERF SPLIN8,CBIN2,CBIN0
PERF GRASPV
SET GTSWFLAG
PERF LINOPT
BNOK WO92
CBG GSWBIN1,=W'90',WO92
MOVE GSWBIN1,TTLINNR
CLEAR GTSWFLAG
PERF FRMXVO,CBIN19
B WO100
WO91
MOVE GTRETUR,CBIN3 INDICATE KONTOKORT
RET
*
WO100
DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER
EDWRT KVOUCH,GTSTRFMT EDWRT WITH CURRENT FORMAT
PERF CRVO
DSC0 .NW,KVOUCH,RLEAS RELEASE VOUCHER
RET
* IN CYCLE
CYVOUCH
SET TTCYTRFL AFTER A CORRECT TRANS
TBT GTCYWRTF,WO5
PERF CYWRT
BNOK WO5
RET
*
WO5
TBT TTTSTFLG,WO10
SET TTTSTFLG
PERF SPLIN8,CBIN5,CBIN2 WRITE 'BILAG'
PERF GRASPV
PERF CLEAR8
WO10
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1 POSITION VOUCHER
EDWRT .NW,KVOUCH,GTSTRFMT
*****
*
* WRITING OF TEXTLINE
* FOR CHECK ON WORKSET
*
*****
SUB TTLINNR,=D'2' NEXT LINE
CBL TTLINNR,=D'4',NEWPG NEW PAGE?
RET NO
*
NEWPG NEW PAGE
TBT TTPSEFLG,WORET T: IF SUBTOTAL
WAIT KVOUCH
MOVE GSWBIN1,TTLINNR
DSC1 KVOUCH,POS,GSWBIN1
MOVE GSWSTR9,=C'TRP '
PERF FRMXVO,CBIN2
EDWRT KVOUCH,GTSTRFMT
DSC0 KVOUCH,RLEAS
SET GTCYTRPF
WORET
RET
PEND
*
*
*
*
GRASPV PROC
********************
*
* GRASP VOUCHER
*
********************
WAIT KVOUCH
DSC0 KVOUCH,GRASP GRASP VOUCHER
RET
PEND
EJECT
LINOPT PROC
********************
*
* CHECK LINE NUMBER, IF ANY
*
********************
TBT GTSWFLAG,LINST
TESTIO KEYB SEE IF INPUT FINISHED
BNOK LINOP1 NO, ABORT
LINST
WAIT KEYB
CBE SPBINW2,CBIN18,LINOP0 SLUT KEY
CBNE SPBINW2,CBIN4,LINOP2 ONLY ENTER KEY ALLOWED
LINOP0
CBG SPBINW1,CBIN3,LINOP2 CHECK LENGTH
MOVE GSWBCD3,SPINPUT GET LINE NR
CBG GSWBCD3,=D'90',LINOP4 SPECIAL FORMATS?
PERF SPCHK5 OK, CHECK LINENR
CBE SPBINW3,CBIN3,LINOP2 ERROR IN LINE NR
MOVE TTLINNR,GSWBIN1 GET CONVERTED LINE NO.
LIN90
CMP CBIN0,CBIN0 SET CR=0,OK
B LINRET
LINOP1
CALL ABORT,KEYB ABORT I/O
CBL GTDFLIN,=W'90',LINOP101
MOVE GSWBCD3,GTDFLIN
B LINOP4
LINOP101
MOVE GSWBCD3,GTDFLIN
MOVE SPINPUT,GSWBCD3
PERF SPCHK5
MOVE TTLINNR,GSWBIN1 SET DEFAULT LINE NO
CMP CBIN0,CBIN0 SET CR=0, OK
MOVE GSWBIN1,CBIN0
B LINRET
LINOP2
DSC0 KVOUCH,RLEAS RELEASE VOUCHER
DSC0 KEYB,SKIB
CMP CBIN0,CBIN1 SET CR<>0, NOT OK
RET
LINOP4
MOVE GSWBIN1,GSWBCD3
B LIN90
LINRET
PERF CLEAR8 DELETE LINE 8
RET
PEND
EJECT
WRITID PROC WRITVAR1,WRITVAR2
********************
*
* PRINTS HEADING IDENTIFIED BY WRITVAR1
* PRINTS ID IDENTIFIED BY WRITVAR2
*
* PRINTS ON JOURNAL AND TALLY
*
*
* WRITVAR1:
* 1 FEJL
* 2 OPSTART
* 3 DISKETTE SKIFT
* 4 KONVERTERING
* 5 DATATRANSMISSION
* 6 BACKUP
*
* WRITVAR2:
* CHARACTERS PRINTED FROM PACKBUFFER:
* 1 1-20 + 40-59
* 2 1-20 + 23-42, IF KONVERTERING
* 2 1-20 + VOLID, IF NOT KONVERTERING
* 3 NOTHING
* 4 VOLID
*
*
*
********************
*
WAIT KJTAPE
IB WRITVAR1,WRID31,WRID32,WRID33,WRID34,WRID35,WRID36
B WRID50
WRID34
MOVE GSWSTR20,=C'FEJL '
B WRID50
WRID31
MOVE GSWSTR20,=C'OPSTART '
B WRID40
WRID32
MOVE GSWSTR20,=C'DISKETTE SKIFT '
B WRID40
WRID33
MOVE GSWSTR20,=C'KONVERTERING '
B WRID40
WRID35
MOVE GSWSTR20,=C'DATATRANSMISSION '
B WRID40
WRID36
MOVE GSWSTR20,=C'BACKUP '
WRID40
PERF WRITJT,=W'12'
PERF FRMXTA,CBIN6
PERF WTALLY
*
*
WRID50
WAIT KTALLY
CBE WRITVAR2,CBIN3,WRID80
CBE WRITVAR2,CBIN4,WRID73
MOVE GSWSTR20,CPCKBUF
PERF WRITJT,=W'12'
CBG WRITVAR1,CBIN3,WRID60
PERF FRMXTA,CBIN6
PERF WTALLY
WAIT KTALLY
*
WRID60
CBE WRITVAR2,CBIN2,WRID70
MOVE GSWBIN2,CBIN20
MOVE GSWBIN1,=W'40'
COPY GSWSTR20,CBIN0,GSWBIN2,CPCKBUF,GSWBIN1
B WRID75
*
WRID70
CBNE WRITVAR1,CBIN4,WRID72
MOVE GSWBIN2,CBIN20
MOVE GSWBIN1,=W'23'
COPY GSWSTR20,CBIN0,GSWBIN2,CPCKBUF,GSWBIN1
B WRID75
WRID72
CBG WRITVAR1,CBIN2,WRID80
WRID73
MOVE GSWSTR20,=' '
MOVE GSWBCD3,CVOLNO
EDIT GSWSTR20,FRVOLID
WRID75
PERF WRITJT,=W'12'
CBL WRITVAR1,CBIN4,WRID76 1,2,3,6
CBL WRITVAR1,CBIN6,WRID90 4,5
WRID76
PERF FRMXTA,CBIN6
PERF WTALLY
WAIT KTALLY
B WRID85
WRID80
CBG WRITVAR1,CBIN3,WRID90
WRID85
PERF FRMXTA,CBIN7
PERF WTALLY
WAIT KTALLY
WRID90
RET
PEND
EJECT
*************************************************
*
* FORMATS FOR WRITFD
*
********************************************************
*
PCKINIT FRMT
FILLR ' ',40
FILLR ' ',40
FBT CSWFLAG,INIT10
FILLR X'00',48
FEXIT
INIT10
FILLR ' ',48
FMEND
*
FRVOLID FRMT
FMEL '999999',CMASKDAT
FILLR ' ',1
FMEL '99999',GSWBCD3
FMEND
*
TREC1 FRMT
FMEL '999',GTMSK
FILLR C'G',1
FMEL '99',CEDATNR
FMEL '99999',CRECBCD
FBT CSPLITFL,TREC40
FMEL '99',GTREGNR
FCOPY =C'&01'
FMEL '9999',CKMDNR
FBF GTKASSE,TREC40
FBT TTR11FLG,TREC10
FCOPY =C'&02'
FMEL '999999',GTDATO
TREC10
FCOPY =C'&03'
FMEL '999',GTMSK
FBT TTR11FLG,TREC40
FCOPY =C'&04'
FMEL '99999',TTLBNR
TREC40
FMEND
*
PFRM1 FRMT
FILLR '&',1
FMEL '99',GSWBCD3
FBP GSWBCD3,PLAB10
FMEL 'TTTTTTTTTTTTT9-',GTDUPF(GSWBIN5)
FEXIT
PLAB10
FMEL 'TTTTTTTTTTTTT9',GTDUPF(GSWBIN5)
FMEND
END