|
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: 14086 (0x3706)
Notes: pts_type(SC)
Names: »DELACT.SC«
└─⟦f350e1b7a⟧ Bits:30009678 Philips computer tape "600219"
└─⟦this⟧ »PTSDEMO/DELACT.SC«
IDENT DELACT LIST ACCOUNTS
DDUM DEMODD
PDIV
EXPROC PAJRN
EXPROC QAFNKY
EXPROC QGATYP
EXPROC XAKBIN
EXPROC XCLAMP
EXPROC XHERAS
EXPROC ZMRDF
EXPROC ZYRLNG
EXPROC QEMOVE
ENTRY DELACT
************************************************************************
* *
* LIST ACCOUNTS*
* *
************************************************************************
DELACT PROC
DE000
SET SBLACT
PERF XHERAS ERASE SCREEN
MOVE TDTRSCDE,=D'30'
PERF PAJRN,=W'1' PRINT FUNCTION IDENTIFICATION
**
* ISSUE AN INITIAL KEYBOARD INPUT (NOWAIT)*
* SPBINW2 WILL POINT INTO THE KEYTABLE*
* TO THE ANSWER GIVEN BY THE OPERATOR*
**
SET SBNOWAIT
PERF XAKBIN,=W'0'
**
* START LISTING AT FIRST ACCOUNT*
* IDACTNR1 WILL CONTAIN THE ACCOUNT TO BE LISTED*
* IDNR1 WILL CONTAIN THE INCREMENT USED TO GET THE*
* NEXT ACCOUNT NUMBER (INITIALLY 1)*
**
DE100
MOVE IDACTNR1,=D'167999'
MOVE IDNR1,=D'1'
MOVE WW1,=W'55'
PERF ZMRDF,WW1,KW0 READ FORMAT INTO FCFORMAT
EDWRT SPDSSCRN,FCFORMAT DISPLAY HEADING
**
* GET THE NEXT ACCOUNT TO BE DISPLAYED*
* *
DE200
**
* FIRST TEST FOR COMPLETION OF THE ISSUED KEYBOARD INPUT*
**
TESTIO SPDSDYKB
BNOK DE400
**
* KI IS COMPLETED, CHECK ANSWER *
* *
*
* IF I/O WAS UNSUCCESSFULL ISSUE A NEW KI-NOWAIT
*
WAIT SPDSDYKB
BNOK DE350
PERF QAFNKY,SPBINW2,KW0,KWAPLKTB
CBE SPBINW2,KWCANCEL,DE980 CANCEL
CBE SPBINW2,KWCONT,DE900 CONTINUE
CBNE SPBINW2,KWEND,DE350 INVALID ANSWER, GO ON
* STOP HAS BEEN DEPRESSED*
DE340
PERF XAKBIN,=W'0' ASK FOR NEW ANSWER
CBE SPBINW2,KWCANCEL,DE980 CANCEL
CBE SPBINW2,KWCONT,DE900 CONTINUE
CBNE SPBINW2,KWSTART,DE340 INVALID ANSWER, ASK AGAIN
* START HAS BEEN DEPRESSED*
DE350
SET SBNOWAIT
PERF XAKBIN,=W'0'
* *
* CALCULATE NEXT ACCOUNT NUMBER*
* *
DE400
ADD IDACTNR1,IDNR1
DE440
* SET SBCHQACT ACCORDING TO THE ACCOUNT TYPE*
PERF QGATYP,IDACTNR1
TBT SBCHQACT,DE450
* SAVINGS ACCOUNT*
CBNG IDACTNR1,YDLASSAV,DE600 VALID ACCOUNT NUMBER
B DE460
* CHEQUE ACCOUNT*
DE450
CBNG IDACTNR1,YDLASCHQ,DE600 VALID ACCOUNT NUMBER
**
* ACCOUNT NUMBER IS NOT VALID*
* IF INCREMENT IS ALREADY 2, THEN RESTART LISTING*
* OTHERWISE TRY THE OTHER TYPE OF ACCOUNT*
* *
DE460
CBE IDNR1,=D'2',DE100
ADD IDACTNR1,IDNR1
* DON'T TRY THIS ACCOUNT TYPE AGAIN*
MOVE IDNR1,=D'2'
B DE440
**
* THE ACCOUNT NUMBER IS A VALID ONE*
* NOW READ THE ACCOUNT RECORD*
**
DE600
MOVE ADACTRNR,IDACTNR1
MUL ADACTRNR,KDSHIFT
MOVE WW1,=W'132' RECORD LENGTH
MOVE WW2,=W'6' XCOPY SIZE PARAMETER
* GET SYMBOLIC KEY*
XCOPY FCBUFFER,KW0,WW2,ADACTRNR,KW0
READ .IXDIR,DSDBS,FCBUFFER,WW1,KW1
BNOK DE800 READ FAILED, NEXT
* MOVE RECORD TO UWB: UA1*
PERF ZYRLNG,ADACTRNR ACT. REC. LENGTH IN NWRECLNG
CALL QEMOVE,ADACTRNR,FCBUFFER,NWRECLNG
CBG ADSTATUS,=D'1',DE800 ACCOUNT CLOSED
**
* DISPLAY ACCOUNT*
**
DE700
EDWRT SPDSSCRN,FMTLACT ACCOUNT LINE
DE800
B DE200 NEXT ACCOUNT
DE900
ADD YDLASSEQ,=D'1'
MOVE TDTRSSEQ,YDLASSEQ
B DE999
*
* CANCEL EXIT
*
DE980
SET SBCANCEL
DE999
CLEAR SBLACT
RET
PEND
************************************************************************
* *
* LIST ACCOUNTS, ACCOUNT LINE (DELACT)*
* *
************************************************************************
FMTLACT FRMT
FNL
FMEL '999999',IDACTNR1
FTAB 8
FMEL '9999',ADCARDNR
FTAB 13
FCOPY ACNAME
FTAB 34
FMEL 'ZZZVZZZVZZ9,99',ADDEPCUM
FTAB 49
FMEL 'ZZZVZZZVZZ9,99',ADWDRCUM
FTAB 64
FMEL '9',ADSTATUS
FMEND
************************************************************************
END