DataMuseum.dk

Presents historical artifacts from the history of:

Philips Data Systems

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Philips Data Systems

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download

⟦830b49074⟧ 

    Length: 4994 (0x1382)
    Notes: pts_type(SC)
    Names: »KKORT.SC«

Derivation

└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
    └─⟦this⟧ »NJ-AMT/KKORT.SC« 
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
    └─⟦this⟧ »NJ-AMT/KKORT.SC«

PTS(SC)

 IDENT KKORT 830504 NJ
         DDUM    KMD08
         PDIV 
 ENTRY KORT 
 ENTRY KKCH 
* 

	EXT	FRMXSP 
	EXT	FRMTKT 
	EXT	FRMXKT 
	EXT	WRITJT 
 EXT ABORT
 EXT EMPTYT 
         EXT     SPCLRA 
         EXT     SPERR
	EXT	SPLIN8 
	EXT	GRASPV 
	EXT	CLEAR8 
	EXT	SPCHK5 
 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 
         END

Full view