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

⟦47003a43b⟧ 

    Length: 7994 (0x1f3a)
    Notes: pts_type(SC)
    Names: »DFOACT.SC«

Derivation

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

PTS(SC)

	IDENT	DFOACT             OPEN ACCOUNT
************************************************************************
*        MODULE-NAME :*
*                DFOACT      OPEN ACCOUNT-NUMBER*
*        PROCEDURES USED :*
*                PAJRN       WRITE JOURNAL*
*                XBFMT       SCREEN-CONTROL*
*                XEERR       ERROR-ROUTINE*
*                ZEINSD      WRITE ACCOUNT-RECORD*
*                SPAP13      CHECKS IF CARD-NUMBRE ALREADY EXISTS     * 
*                ZCRDD       READ ACCOUNT-RECORD                       *
**
************************************************************************
	DDUM	DEMODD			
	PDIV				
	ENTRY	DFOACT			
	ENTRY	SPAP13 
	EXPROC	XHMSU	WRITE BADGE CARD
	EXPROC	PAJRN			 
	EXPROC	XBFMT			 
	EXPROC	ZCRDD 
	EXPROC	ZEINSD
	EXPROC	XEERR			 
	EJECT				
************************************************************************
* 
* OPEN ACCOUNT (CHEQUE OR SAVINGS)
* 
************************************************************************
DFOACT	PROC				
DF000					
	TBT	SBCHEQUE,DF100			
	ADD	YDLASSAV,=D'2'			 
	CBG	YDLASSAV,=D'168999',DF900			
	MOVE	IDACTNR1,YDLASSAV			
	B	DF200			
DF100					
	ADD	YDLASCHQ,=D'2'			
	CBG	YDLASCHQ,=D'168999',DF900			
	MOVE	IDACTNR1,YDLASCHQ			
DF200	       				
*        PRINT JOURNAL-ROLL*
	SET	SBOACT 
	PERF	PAJRN,=W'1'	LINE TYPE 1 
	MOVE	TDTRSCDE,=D'080'			
	PERF	PAJRN,=W'2'    			
* 
* DISPLAY THE OPEN ACCOUNT SCREEN 
* 
DF300					
	PERF	XBFMT,=D'39'			
	TBT	SBCANCEL,DF999			
	TBF	SBCHEQUE,DF350 
* 
* FOR CHEQUE ACCOUNTS:
* TO GET A CARDNUMBER-KEY WITHOUT BCD 'F' CHARACTERS, 
* ADCARDNR IS MULTIPLIED BY 1.
* IN THIS WAY EACH 'F' IS REPLACED BY '0' 
* 
	MUL	ADCARDNR,=D'1' 
	TBF	SBCARD,DF350	NO 'CARD' 
	PERF	XHMSU,ADCARDNR	WRITE BADGE CARD 
* 
*        INITIATE ACCOUNT-RECORD AND TRANSACTION-RECORD*
* 
DF350 
	MOVE	ADACTRNR,IDACTNR1 
	MUL	ADACTRNR,KDSHIFT 
	ADD	YDLASSEQ,=D'1'			
	MOVE	ADLASSEQ,YDLASSEQ			
	MOVE	TDTRSSEQ,ADLASSEQ			
DF400					
*        WRITE ACCOUNT-RECORD*
	PERF	ZEINSD,ADACTRNR			
	B	DF999			
DF900					
	PERF	XEERR,=D'29',KW1	ERROR-MESSAGE , ANSWER MUST		
*                                      BE "CANCEL"*
DF999					
	CLEAR	SBOACT 
	RET				
	PEND				
	EJECT
************************************************************************
* 
* PROCEDURE NAME:  SPAP13 
*       THIS ROUTINE CHECKS THE CARD-NUMBER KEYED IN IN OPEN-CHEQUE-
*       ACCOUNT ( DFOACT )  AS FOLLOWS :
*       -  CARD-NUMBER IN THE RANGE  1001-9999
*       -  CARD-NUMBER MAY NOT ALREADY EXIST
************************************************************************
SPAP13	PROC	XWRET 
	PBIN	XWRET 
S13000
	CBL	ADCARDNR,=D'1001',S13200 
	CBG	ADCARDNR,=D'9999',S13200 
         MOVE      ADACTRNR,ADCARDNR
* 
* SEE IF RECORD IS AVAILABLE ALREADY
* THE RECORD MUST NOT BE COPIED TO THE UWB, 
* SO SBNOCOPY IS SET FIRST
* 
	SET	SBNOCOPY	DON'T COPY TO UWB 
         PERF      ZCRDD,ADACTRNR,NDLRN1,KW2       READ VIA INDEX 2 
	TBT	SBCANCEL,S13999
	TBT	SBRECAVB,S13100
	B	S13999 
S13100
	MOVE	SPBINW4,=W'29'
	MOVE	XWRET,=W'1' 
	B	S13999 
S13200
	MOVE	SPBINW4,=W'1'	VALUE NOT IN RANGE
	MOVE	XWRET,=W'1' 
S13999
	RET
	PEND 
************************************************************************
	END

Full view