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

⟦0c7544cf5⟧ 

    Length: 11112 (0x2b68)
    Notes: pts_type(SC)
    Names: »DMWDR.SC«

Derivation

└─⟦35fda6e03⟧ Bits:30009701 Philips computer tape "BARCLAY"
    └─⟦this⟧ »DEMO6800/DMWDR.SC« 
└─⟦e276fd206⟧ Bits:30009696 Philips computer tape "600413"
    └─⟦this⟧ »DEMO6800/DMWDR.SC«

PTS(SC)

         IDENT    DMWDR                 WITHDRAWAL
	DDUM	DEMODD			
	PDIV				
	EXPROC	PAJRN			 
	EXPROC	PBBOOK			 
	EXPROC	PCVCH			 
	EXPROC	QENTRS			 
	EXPROC	XBFMT			 
	EXPROC	ZCRDD 
	EXPROC	ZDRWRD
	EXPROC	ZHWRID			 
	ENTRY	DMWDR			
	ENTRY	SPAP14 
************************************************************************
**
* WITHDRAWAL OF A CHEQUE OR SAVINGS ACCOUNT*
**
************************************************************************
DMWDR	PROC				
DM000					
	SET	SBWDR
	TBT	SBCHEQUE,DM100			
	MOVE	TDTRSCDE,=D'2'	SBCHEQUE IS OFF		
	B	DM200			
DM100					
	MOVE	TDTRSCDE,=D'16'	SBCHEQUE IS ON		
DM200					
**
* PRINT LINE TYPE 2*
**
	PERF	PAJRN,=W'2'			
	MOVE	TDNEWBAL,=D'0'	INITIALISE NEW BALANCE		
	TBF	SBFT80,DM210	NO COMPACT TERMINAL 
	PERF	XBFMT,=W'70'
	B	DM220
DM210 
	PERF	XBFMT,=W'42'	WITHDRAWAL FORMAT		
DM220 
	TBT	SBCANCEL,DM999			
**
* PRINT LINE TYPE 7*
**
         MOVE    ICTEXT3,YCCCY(KW4)    SYSTEM CURRENCY
	PERF	PAJRN,=W'7'			
**
* FILL TRANSACTION RECORD*
*    GET NEXT TRANSACTION-RECORD KEY*
**
	PERF	QENTRS,ADLASTRS	UPDATE TRANSACTION SEQ. NR
	MOVE	TDTRSRNR,ADACTRNR	ACCOUNT RECORD NR.
	ADD	TDTRSRNR,ADLASTRS	TRANS. RECORD KEY
	ADD	YDLASSEQ,=D'1'	UPDATE LAST TRANS. SEQ. NR. 
	MOVE	TDTRSSEQ,YDLASSEQ	MOVE TO TRANS. RECORD		
* 
* TDAMOUNT CONTAINS THE AMOUNT KEYED IN BY THE OPERATOR 
* 
	TBF	SBRVS,DM250			
	MUL	TDAMOUNT,=D'-1'	UPDATE AMOUNT		
DM250					
	TBF	SBCHQACT,DM300			
*** MOVE TDCHQNR,FCFIELD*
DM300					
**
* FILL ACCOUNT RECORD*
**
	MOVE	ADBAL,TDNEWBAL	NEW BALANCE		
	ADD	ADWDRCUM,TDAMOUNT	ACCUMULATED WITHDR.		 
	MOVE	ADLASSEQ,TDTRSSEQ	TRANS. SEQ. NR.		
**
* WRITE ACCOUNT AND TRANSACTION RECORD*
**
DM700					
	PERF	ZHWRID,TDTRSRNR,NDLRN2	TRANSACTION RECORD		
	TBT	SBCANCEL,DM999 
	PERF	ZDRWRD,ADACTRNR,NDLRN1	ACCOUNT RECORD		
	TBT	SBCANCEL,DM999 
*   *
* UPDATE OPERATOR BALANCES*
**
DM750 
	SUB	ODCASH(KW1,KW4),TDAMOUNT	BALANCE CASH		
	ADD	ODCASH(KW2,KW4),TDAMOUNT	ACCUMULATED WITHDRAWALS		
	TBF	SBCHEQUE,DM800			
	ADD	ODCASH(KW2,KW1),TDAMOUNT	ACCUMULATED CHEQUES		
**
* PRINT VOUCHER OR PASSBOOK*
*    IF A TERMINAL PRINTER IS AVAILABLE*
**
DM800 
	CBNL	RDPRTTYP,=D'2',DM999	NO TERMINAL PRINTER		 
	TBT	SBCHQACT,DM820			
**
* SAVINGS ACCOUNT, PRINT BOOK*
**
	PERF	ZCRDD,ADACTRNR,NDLRN1,KW1	READ ACCOUNT FOR PBBOOK 
	TBT	SBCANCEL,DM999 
	PERF	PBBOOK
	B	DM999
**
* CHEQUE ACCOUNT, PRINT VOUCHER(S)*
**
DM820 
	TBF	SBCHEQUE,DM850	SBCHEQUE IS OFF		
*** PRINT CHEQUE*
DM850 
	PERF	PCVCH,=W'2'			
DM999					
	CLEAR	SBWDR
	RET				
	PEND				
************************************************************************
**
* CALCULATE NEW BALANCE (FMT042(WITHDRAWAL) AND FMT045(TRANSFER)) 
**
************************************************************************
SPAP14	PROC	XWRET 
	PBIN	XWRET 
S14000					
	MOVE	TDNEWBAL,TDAMOUNT			
	TBT	SBRVS,S14100			
	MUL	TDNEWBAL,=D'-1'	NOT REVERSAL		
S14100					
	ADD	TDNEWBAL,ADBAL	NEW BALANCE		 
* *
*  REDISPLAY NEXT FIELD IN FORMAT 
* 
	TBT	SBWDR,S14125 
* 
* NOT WITHDRAWAL, NEW BALANCE IS ON LINE 4
* 
	CBL	RDSCRLNS,=D'4',S14150
	ERASE	0,KW4,KW4
	DISPLAY	4,KW4,KW4	DISPLAY NEW BALANCE
	B	S14150 
S14125
	CBL	RDSCRLNS,=D'5',S14150
	ERASE	0,KW5,KW5
	DISPLAY	4,KW5,KW5
* 
* CHECK SUFFICIENT FUNDS*
* *
S14150
	MOVE	WDEC1,TDNEWBAL			
	TBF	SBCHQACT,S14200	SAVINGS ACCOUNT		
**
* CHEQUE ACCOUNT*
**
	MOVE	WDEC1,TDNEWBAL			
	ADD	WDEC1,ADLIMBOK	CREDIT LIMIT		
**
* SAVINGS AND CHEQUE ACCOUNT*
**
S14200					
	CBNL	WDEC1,=D'0',S14990	FUNDS ARE SUFFICIENT		
**
* ERROR: INSUFFICIENT FUNDS*
**
	MOVE	SPBINW4,=W'35'			
	MOVE	XWRET,=W'1'	INDICATE ERROR		
S14990					
	RET				
	PEND				
************************************************************************
	END

Full view