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

⟦8742db872⟧ 

    Length: 16844 (0x41cc)
    Notes: pts_type(SC)
    Names: »CEGACT.SC«

Derivation

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

PTS(SC)

         IDENT    CEGACT                GET ACCOUNT 
	DDUM	DEMODD			
	PDIV				
	EXPROC	DKDSTM
	EXPROC	PBBOOK
	EXPROC	QENTRS
	EXPROC	QGATYP
	EXPROC	XBFMT			 
	EXPROC	XEERR 
	EXPROC	XGBCR 
	EXPROC   	ZCRDD			 
	EXPROC	ZGREA 
	ENTRY	CEGACT			
************************************************************************
**
* GET ACCOUNT 
**
************************************************************************
CEGACT	PROC				
CE000					
	CBNE	NWKTBIX,=W'11',CE100	NOT 'TRANSFER' 
	TBT	SBCARD,CE100	'TRANSFER' AND 'CARD' 
	B	CE999	'TRANSFER' AND NOT 'CARD'
**
* GET ADDITIONAL INPUT*
**
CE100					
	TBF	SBCARD,CE120			
**
* BADGE CARD READER INPUT*
**
CE110					
	PERF	XBFMT,=W'27'	'DRAW CARD THROUGH BCR'		
	TBF	SBCANCEL,CE115 
	B	CE999
CE115 
	TBF	SBMSU,CE116
	MOVE	WWINDEX1,KW2	TRACK NUMBER 
CE116 
	PERF	XGBCR	GET ACCOUNT NUMBER		
	TBT	SBMSU,CE140
	CBNE	SPBINW2,KW2,CE140	NO READ ERROR 
	PERF	XEERR,=W'32',KW2
	B	CE110
CE120					
	TBF	SBCHEQUE,CE130			
**
* OPTICAL DOCUMENT READER INPUT*
**
	B	CE970	READ ACCOUNT RECORD		
* 
* KEYBOARD INPUT*
**
CE130					
	PERF	XBFMT,=W'27'	GET ACCOUNT NUMBER		
	TBF	SBCANCEL,CE140 
	B	CE999	CANCEL 
***********************************************************************
**
* PERFORM CHECKS ON NUMBER ENTERED*
**
***********************************************************************
CE140 
	CBNE	NWKTBIX,=W'8',CE150	NEXT CHECK
	CBNE	IDACTNR1,=D'0',CE150
**
* NUMBER ENTERED = 0 AND 'D-S'*
*    A GTP OR LP MUST BE AVAILABLE*
**
	CBE	RDPRTTYP,=D'2',CE149	GTP AVAILABLE		
	CBE	YDMLPINT,=D'1',CE149	LINE PRINTER AVAILABLE		
	B	CE990
CE149 
	B	CE999	LONGBRANCH 
CE150					
	CBL	IDACTNR1,=D'1001',CE920	   ERROR		
	CBL	IDACTNR1,=D'10000',CE200	   READ ACCOUNT RECORD		 
	CBL	IDACTNR1,=D'10001',CE920	NOT IN RANGE
	CBL	IDACTNR1,=D'20000',CE180	POSSIBLE OPR. CLOSE 
	CBL	IDACTNR1,=D'168000',CE920	     ERROR		
	CBL	IDACTNR1,=D'169000',CE210	     READ ACCOUNT RECORD		
	B	CE920	ERROR		
* 
* POSSIBLE OPERATOR CLOSE 
* 
CE180 
	CBNE	NWKTBIX,=W'4',CE920	NO CLOSE
	CBNE	IDACTNR1,RDOPRNR,CE990	INVALID KEY
* 
* NUMBER ENTERED IS THE CURRENT OPERATOR NUMBER AND 
* CLOSE HAS BEEN REQUESTED
* 
	SET SBOPRCLS	SET OPR. CLOSE SWITCH 
	B	CE999	RETURN 
**
* RECORD NUMBER IS IN THE RIGHT RANGE*
**
CE200					
* 
* READ VIA INDEX 2
* 
	MOVE	ADACTRNR,IDACTNR1 
	PERF	ZCRDD,ADACTRNR,NDLRN1,KW2 
	B	CE250
* 
* READ VIA INDEX 1
* 
CE210 
	MOVE	ADACTRNR,IDACTNR1			
	MUL	ADACTRNR,KDSHIFT			
	PERF	ZCRDD,ADACTRNR,NDLRN1,KW1	 		
CE250 
	TBT	SBCANCEL,CE999			
	TBF	SBRECAVB,CE990	RECORD NOT AVAILABLE		
***********************************************************************
**
* ACCOUNT RECORD AVAILABLE*
* PERFORM CHECKS ON THE RECORD READ 
**
***********************************************************************
CE300					
	MOVE	IDACTNR1,ADACTRNR 
	DIV	IDACTNR1,KDSHIFT	SAVE ACCOUNT NUMBER 
* 
* SET SBCHQACT ACCORDING TO THE ACCOUNT TYPE
* 
	PERF	QGATYP,IDACTNR1 
	CBL	ADSTATUS,=D'2',CE400	ACCOUNT NOT CLOSED		
**
* ACCOUNT CLOSED*
* IF MASTER KEY UPDATE, CONTINUE
**
	TBF	SBKEY2,CE340			
	CBE	NWKTBIX,=W'6',CE400	'UPDATE' 
CE340 
	CBE	ADSTATUS,=D'3',CE990	CLOSED WITH STATEMENT 
**
* ACCOUNT CLOSED WITHOUT STATEMENT*
* IF FUNCTION CHOISE IS DAILY STATEMENTS, CONTINUE
*    PERFORM DAILY STATEMENTS OR PRINT PASSBOOK*
*    IF A TELLER TERMINAL PRINTER IS AVAILABLE*
* *
	CBE	NWKTBIX,=W'8',CE400	SKIP IF 'D-S'
	CBE	RDPRTTYP,=D'2',CE990	'RECORD KEY INVALID 
	TBT	SBCHQACT,CE360			
**
* SAVINGS ACCOUNT, PRINT PASSBOOK*
* PRINT ALL UNSTATEMENTED TRANSACTIONS AND A CLOSE LINE 
**
	TBT	SBNOBOOK,CE990 
	PERF	PBBOOK
	B	CE370
* *
* CHEQUE ACCOUNT, PRINT DAILY STATEMENTS*
**
CE360					
	PERF	DKDSTM
CE370 
	TBT	SBCANCEL,CE999 
	B	CE990			
CE400					
	CBE	ADSTATUS,=D'0',CE500	DEBLOCKED		
**
* ACCOUNT BLOCKED*
**
	CBE	NWKTBIX,=W'7',CE500	'INQUIRY' ALLOWED		
	CBE	NWKTBIX,=W'8',CE500	'D-S' ALLOWED
	TBF	SBKEY2,CE980	ELSE KEY 2 MUST BE ON		
	CBE	NWKTBIX,=W'6',CE500	AND 'UPDATE'		
	CBE	NWKTBIX,=W'5',CE500	OR 'BLOCK'		
	B	CE980	ERROR, ACCOUNT BLOCKED		
***********************************************************************
* 
*   ADDITONAL CHECKS
**
***********************************************************************
* 
* CHECK CLOSE 
**
CE500					
	CBNE	NWKTBIX,=W'4',CE505 
	CBNE	ADBAL,=D'0',CE950	ERROR 
* 
* CHECK D-S 
* 
CE505 
	CBNE	NWKTBIX,=W'8',CE510 
	CBG	RDPRTTYP,=D'1',CE910	NO TTP OR TEP 
* 
* CHECK OUT 
* 
CE510 
	CBNE	NWKTBIX,=W'10',CE520	NOT 'OUT'
	TBF	SBCHEQUE,CE520	NOT 'CHEQUE'
* 
* CHEQUE/OUT
* 
	TBF	SBCHQACT,CE940	MUST BE CHEQUE ACCOUNT
* 
* CHECK IF THERE IS ENOUGH SPACE FOR ONE MORE 
* TRANSACTION RECORD
* IN CASE OF DEPOSIT, WITHDRAWAL OR TRANSFER
* 
CE520 
	CBE	NWKTBIX,=W'9',CE525	'IN' 
	CBE	NWKTBIX,=W'10',CE525	'OUT' 
	CBE	NWKTBIX,=W'11',CE525	'TRANSFER'
	B	CE600
CE525 
	MOVE	WDEC1,ADLASTRS
	PERF	QENTRS,WDEC1	NEXT TRANSACTION NR. 
	CBNE	ADSTMTRS,WDEC1,CE600	OKE
* 
*  NO MORE FREE RECORDS AVAILABLE, PRINT UNST. TRANSACTIONS 
* 
	CBE	RDPRTTYP,=D'2',CE930	NO SUITABLE PRINTER 
	TBT	SBCHQACT,CE550 
* 
* SAVINGS ACCOUNT, PRINT UNSTATEMENTED TRANSACTIONS 
* 
	TBT	SBNOBOOK,CE930	'NOBOOK' IS ON
	PERF	PBBOOK
	B	CE560
* 
* CHEQUE ACCOUNT, PRINT DAILY STATEMENTS
* 
CE550 
	PERF	DKDSTM	DAILY-STATEMENTS 
CE560 
	TBT	SBCANCEL,CE999 
* 
* THE ACCOUNT RECORD HAS BEEN REWRITTEN BY PBBOOK OR DKDSTM,
* SO READ IT AGAIN TO GET EXCLUSIVE ACCES 
* 
	PERF	ZCRDD,ADACTRNR,NDLRN1,KW1 
	TBT	SBCANCEL,CE999 
CE600 
	B	CE999			
************************************************************************
* 
* DISPLAY ERROR: REQUIRED DEVICE TYPE NOT SPECIFIED 
* 
************************************************************************
CE910 
	PERF	XEERR,=W'33',KW2
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: VALUE NOT IN RANGE 
* 
************************************************************************
CE920 
	PERF	XEERR,=W'1',KW2 
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: NO TRANSACTIONS POSSIBLE 
* 
************************************************************************
CE930 
	PERF	XEERR,=W'56',KW2
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: SAVINGS ACCOUNT
* 
************************************************************************
CE940 
	PERF	XEERR,=W'34',KW2
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: BALANCE NOT ZERO 
* 
************************************************************************
CE950 
	PERF	XEERR,=W'37',KW2
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: UNSERVICEABEL REQUEST
* 
************************************************************************
CE960 
	PERF	XEERR,=W'20',KW2
	B	CE998
************************************************************************
* 
* DISPLAY ERROR: INPUT DEVICE FAILURE 
* 
************************************************************************
CE970 
	PERF	XEERR,=W'32',KW2
	B	CE998
************************************************************************
**
* DISPLAY ERROR: ACCOUNT BLOCKED*
**
************************************************************************
CE980					
	PERF	XEERR,=W'28',KW2
	B	CE998
************************************************************************
**
* DISPLAY ERROR: RECORD KEY INVALID*
**
************************************************************************
CE990 
	TBF	SBMSU,CE992
	TBF	SBCARD,CE992 
	CBE	WWINDEX1,KW3,CE992 
	MOVE	WWINDEX1,KW3	TO READ TRACK 3
	B	CE116
CE992 
	PERF	XEERR,=W'29',KW2
CE998 
	TBT	SBCANCEL,CE999 
	PERF	ZGREA	RELEASE EXCLUSIVE ACCES 
	B	CE100	RESTART INPUT
CE999					
	RET				
	PEND				
************************************************************************
	END

Full view