|
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: 39662 (0x9aee)
Notes: pts_type(SC)
Names: »TABSIM.SC«
└─⟦cd4bbebb4⟧ Bits:30009680 Philips computer tape "600221"
└─⟦this⟧ »ATM/TABSIM.SC«
IDENT TABSIM 830729 NJ
**********************************************************
* *
* THIS PROCEDURE CONTAINS MOST OF THE SUBROUTES REQUIRED *
* FOR TESTING THE PTS 6601 *
* *
**********************************************************
DDUM DDIV
PDIV
ENTRY SENDFC
ENTRY CUSREQ
ENTRY SOLLST
ENTRY UNSTAT
ENTRY OPENLN
ENTRY READOK
ENTRY ADDPOL
ENTRY KBINP
ENTRY KINW
ENTRY DCNW
ENTRY DLLATM
ENTRY RECHK
ENTRY SCRIBE
ENTRY OPRCMD
EXPROC LOADER
EXT RECASM
EXT COPY4
ENTERK EQU X'0D' ENTER KEY CODE
CANCEL EQU X'0A' CANCEL KEY CODE
DLLD EQU X'18' FORCE DOWNLINELOAD
PENGE EQU X'00' LOAD MORE MONEY
KLOKKEN EQU X'00' SET TIME
NYTBDT EQU X'00' NYTT BUNTNR.
LUKKES EQU X'00' CLOSE MACHINE
KTAB1 KTAB ENTERK,CANCEL,DLLD,PENGE,KLOKKEN,NYTBDT,LUKKES
EJECT
READOK PROC
*
****** READ OK
*
CBE LENGTH,COB0,READ10 READ AGAIN IF LEN=0
CBNG LENGTH,COB4,READ20
DLETE BUFIN,COB0,COB4 DELETE CONTROL CHARACTERS
SUB LENGTH,COB4 REDUCE LENGTH BY 4
XCOPY BUFIN,LENGTH,COB2,FS,COB0 ADD 2 FIELD SEPERATORS
ADD LENGTH,COB2 INCREASE LENGTH BY 2
XCOPY BIN1,COB0,COB2,BUFIN,COB0 COPY MESSAGE IDENTIFIERS
CBE BIN1,=C'22',READ30 SOLL.STATUS
CBE BIN1,=C'12',READ40 UNSOLL.STATUS
CBE BIN1,=C'11',READ50 CUSTOMER REQUEST
MOVE VARIOUS,=C'INVALID MESSAGE RECEIVED '
PERF SCRIBE,VARIUS
READ02 FIND NEXT FS
MOVE PNT1,COB0
MATCH BUFIN,PNT1,LENGTH,FS,COB0,COB1 SEARCH FOR FS
BNZ READ04 NO MATCH
XCOPY BUFIN,PNT1,COB1,CHAR2,COB0 EXCHANGE FS FOR .
B READ02 FIND NEXT FS
READ04 NO MATCH
MOVE BIN3,=W'80' SET BIN3 TO 80
READ06 TEST LENGTH
CBL LENGTH,BIN3,READ08 TEST FOR LENGTH<80
XCOPY INFO,COB0,BIN3,BUFIN,COB0 COPY BUFIN INTO INFO
PERF SCRIBE,INF DISPLAY DATA
DLETE BUFIN,COB0,BIN3 DELETE DATA FROM BUFIN
SUB LENGTH,BIN3 REDUCE LENGTH BY 80
B READ06 TEST LENGTH AGAIN
READ08 LENGTH<80
MOVE INFO,=C' ' CLEAR INFO
XCOPY INFO,COB0,LENGTH,BUFIN,COB0 REMAINING DATA INTO INFO
PERF SCRIBE,INF DISPLAY DATA
READ10 DO NEW READ
MOVE RETUR,COB0
B READ90
READ20 LENGTH < 5
MOVE INFO,=C' ' CLEAR INFO
XCOPY INFO,COB0,LENGTH,BUFIN,COB0 REMAINING DATA INTO INFO
PERF SCRIBE,INF DISPLAY DATA
MOVE RETUR,COB0
B READ90
READ30 SOLL.STATUS
MOVE RETUR,COB1
B READ90
READ40 UNSOLL.STATUS
MOVE RETUR,COB2
B READ90
READ50 CUSTOMER REQUEST
MOVE RETUR,COB3
B READ90
READ90 EXIT POINT
RET
PEND
EJECT
CUSREQ PROC
*
****** CUSTOMER REQUEST
*
CLEAR ERROR
DLETE BUFIN,COB0,COB9 REMOVE UNWANTED MESSAGE DATA
SUB LENGTH,COB9 SUBTRACT 9 FROM LENGTH
CLEAR F1 CLEAR FLAGS F1-F9
CLEAR F2
CLEAR F3
CLEAR F4
CLEAR F5
CLEAR F6
CLEAR F7
CLEAR F8
CLEAR F9
PERF UNLOAD,COMB,F1,=W'2' TXFG AND MESS COMBINED
XCOPY TXFG,COB0,COB1,COMB,COB0 COPY TXFG
XCOPY MESS,COB0,COB1,COMB,COB1 COPY MESS
PERF UNLOAD,TK2D,F2,=W'40' TRACK 2 DATA
PERF UNLOAD,TK3D,F3,=W'106' TRACK 3 DATA
MOVE TK3DL,PNT1 STORE TRACK 3 DATA LENGTH
PERF UNLOAD,OPKY,F4,=W'8' OPERATION KEYS
PERF UNLOAD,PPPP,F5,=W'16' POUNDS AND PENCE
PERF UNLOAD,GPBA,F6,=W'32' GENERAL PURPOSE BUFFER A
MOVE GPBA,=C' '
PERF UNLOAD,GPBB,F7,=W'32' GENERAL PURPOSE BUFFER B
PERF UNLOAD,GPBC,F8,=W'32' GENERAL PURPOSE BUFFER C
PERF UNLOAD,TK1D,F9,=W'80' TRACK 1 DATA
MOVE PBCD,PPPP MOVE 'MONEY' INTO BCD FIELD
MOVE NOTES,=C'0'
CBNE OPKY,=C'A ',CUSR02
CBL PBCD,=D'100',CUSR07
DIV PBCD,=D'100' THROW AWAY DECIMAL PART
CBG PBCD,DLIMIT,CUSR07 ABOVE LIMIT?
PERF LOMULT
BNOK CUSR07
PERF NOTMIX COMPUTE NOTEMIX
B CUSR08
CUSR02
CBNE OPKY,=C'B ',CUSR04
B CUSR08
CUSR04
CBNE OPKY,=C'C ',CUSR06
B CUSR08
CUSR06
CBNE OPKY,=C'D ',CUSR08
B CUSR08
CUSR07 INVALID AMOUNT ENCOUNTERD
MOVE OPKY,=C'X '
SET ERROR
CUSR08
MOVE BIN2,LENGTHS(COB2) BIN2 EQUALS LENGTH OF TK1D1
XCOPY TK1D1,COB0,BIN2,TK1D,COB0 COPY FIRST HALF OF TK1D
MOVE BIN3,LENGTHS(COB3) BIN3 EQUALS LENGTH OF TK1D2
XCOPY TK1D2,COB0,BIN3,TK1D,BIN2 COPY SECOND HALF OF TK1D
XCOPY TK3D1,COB0,BIN2,TK3D,COB0 COPY FIRST HALF OF TK3D
MOVE BIN3,LENGTHS(COB7) BIN3 EQUALS LENGTH OF TK3D2
XCOPY TK3D2,COB0,BIN3,TK3D,BIN2 COPY SECOND HALF OF TK3D
COPY WKSTG1,COB0,COB1,MESS,COB0 STORE TRUE VALUE OF MESS
PERF SCRIBE,CUSTRQ DISPLAY CUSTOMER REQUEST DATA
COPY MESS,COB0,COB1,WKSTG1,COB0 RESET VALUE OF MESS
MOVE FCBLDX,COB1 SET FCBLD INDEX TO FIRST ITEM
CUSR10 MATCH OPERATION KEYS
MOVE PNT1,COB0 SET PNT1 TO START OF DATA
MATCH FCBLD(FCBLDX),PNT1,COB8,OPKY,COB0,COB8 COMPARE STRINGS
BZ CUSR90
CBE FCBLDX,=W'30',CUSR20 TEST FOR END OF TABLE
ADD FCBLDX,COB1 INCREMENT INDEX
B CUSR10 SEARCH FCBLD TABLE AGAIN
CUSR20 NO MATCH FOUND
PERF SCRIBE,FCMD
MOVE FCBLDX,COB1 DEFAULT COMMAND
CUSR90
TBF ERROR,CUSR95
PERF SCRIBE,AMTERR
CUSR95
MOVE RETUR,COB0
RET
PEND
EJECT
SOLLST PROC
*
****** SOLICITED STATUS MESSAGE
*
TBT RESFG,SOLL010 TEST RESPONSE EXPECTED FLAG
MOVE VARIOUS,=C'UNEXPECTED MESSAGE RECEIVED '
PERF SCRIBE,VARIUS
SOLL010 UNLOAD STATUS DESCRIPTOR
CLEAR RESFG CLEAR RESPONSE EXPECTED FLAG
DLETE BUFIN,COB0,COB7 DELETE UPTO STATUS DESCRIPTOR
CLEAR DUMMY CLEAR DUMMY FLAG
PERF UNLOAD,STAT,DUMMY,=W'1' COPY DATA INTO STAT
CBE STAT,=C'8',SOLL040 DEVICE FAULT,CONFIG.DATA
CBE STAT,=C'9',SOLL020 READY
CBE STAT,=C'A',SOLL030 COMMAND REJECT
CBE STAT,=C'B',SOLL020 READY
SOLL020 READY
MOVE VARIOUS,=C'READY '
PERF SCRIBE,VARIUS
B SOLL080
SOLL030 COMMAND REJECT
MOVE VARIOUS,=C'COMMAND REJECT '
PERF SCRIBE,VARIUS
B SOLL090
SOLL040 DEVICE FAULT
CLEAR DUMMY CLEAR DUMMY FLAG
PERF UNLOAD,COMB2,DUMMY,=W'2' COPY DID + DEVICE STATUS
XCOPY DID,COB1,COB1,COMB2,COB0 COPY DID
SUB DID,=W'49' CONVERT DID TO INDEX VALUE
SUB PNT1,COB2 SET PNT1 TO DATA LENGTH
MOVE DEVST,=C' ' CLEAR DEVICE STATUS FIELD
XCOPY DEVST,COB0,PNT1,COMB2,COB1 COPY DEVICE STATUS DATA
MOVE WKSTG4,=X'1D' GROUP SEPRARATOR
MOVE BIN4,=W'32' LENGTH OF 'DEVST'
MOVE BIN3,COB0
CLEAR DUMMY
MATCH DEVST,BIN3,BIN4,WKSTG4,COB0,COB1 ANY <GS>?
BNOK SOLL050 NO, NOT THIS TIME
SET DUMMY <GS> FOUND
SOLL050
PERF SCRIBE,ERROR 'DEVICE--STATUS'
* HERE THE GROUP IDENTIFIERS PLUS THE STATUS-
* HANDLING SHOULD BE IMPLEMENTED
CMP DID,COB1 TEST FOR PRINTER FAULT
BE SOLL090
MOVE FCBLDX,COB1 SET FCBLDX INDEX
SOLL080
MOVE RETUR,COB1 READ LINE MSG
B SOLL095
SOLL090
MOVE RETUR,COB0 RETRY READ
SOLL095
RET
PEND
EJECT
OPENLN PROC
*
****** OPEN LINE TO ATM
*
MOVE BIN2,=X'00A2' CODE FOR OPEN LINE
PERF OPL
IB BIN3,OPL010,OPL020,OPL030
B OPL030
OPL010 LINE OPENED
CLEAR MESFG
MOVE VARIOUS,=C'LINE OPENED '
PERF SCRIBE,VARIUS
MOVE RETUR,COB0 OK
B OPL090
OPL020 MODEM INOPERABLE
TBT MESFG,OPL025 ALREADY DISPLAYED?
MOVE VARIOUS,=C'LINE NOT OPERABLE '
PERF SCRIBE,VARIUS
SET MESFG SET 'MESSAGE DISPLAYED' FLAG
OPL025
MOVE RETUR,COB1
B OPL090
OPL030 LINE ALREADY OPEN
MOVE BIN2,=X'00A4' CLOSE LINE CODE
PERF OPL CLOSE LINE
DELAY TIME DELAY
MOVE RETUR,COB2
OPL090
RET
PEND
EJECT
ADDPOL PROC
*
****** ADD ATM TO POLL LIST
*
CLEAR INACTIV
ADD005
MOVE BIN2,=X'00B7' 'ADD TO POLL LIST' CODE
CALL RECASM,DSCMOP,BIN2,ADR,BIN3 ASS. SUBROUTINE
IB BIN3,ADD010,ADD020,ADD030
MOVE RETUR,COB1 RETURNCODE INVALID
B ADD090
ADD010
PERF SCRIBE,POLL
MOVE RETUR,COB0
B ADD090
ADD020 MODEM INOPERABLE
MOVE RETUR,COB2
B ADD090
ADD030
TBT INACTIV,ADD040 2ND TIME?
PERF SCRIBE,INACT
SET INACTIV
ADD040
B ADD005
ADD090
RET
PEND
EJECT
UNSTAT PROC
*
****** UNSOLICITED STATUS MESSAGE
*
MOVE DID,COB3 FIND POWERFAIL MESSAGE
MATCH BUFIN,DID,COB2,FS,COB0,COB2 AND EXPAND IT
BERR UNST010
INSRT BUFIN,COB0,COB3,WKSTG1,COB0
UNST010
MOVE DID,COB0
DLETE BUFIN,COB0,COB8 DELETE UPTO STATUS SOURCE
CLEAR DUMMY CLEAR DUMMY FLAG
PERF UNLOAD,COMB2,DUMMY,=W'2' STATUS SOURCE + DEVICE STATUS
TBT DUMMY,UNST020
XCOPY DID,COB1,COB1,COMB2,COB0 COPY STATUS SOURCE
SUB DID,=W'48' CHANGE STATUS SOURCE TO INDEX
SUB PNT1,COB2 LENGTH OF DEVICE STATUS DATA
MOVE DEVST,=C' ' CLEAR DEVICE STATUS FIELD
XCOPY DEVST,COB0,PNT1,COMB2,COB1 COPY DEVICE STATUS DATA
PERF SCRIBE,UNSS 'UNSOLICITED STATUS DD+SS '
IB DID,UNST030,UNST040,UNST070,UNST045, C
UNST050,UNST055,UNST060,UNST065
B UNST090 INVALID DEVICE,READ AGAIN
UNST020
MOVE VARIOUS,=C'UNSOLL.STATUS FROM UNKNOWN DEVICE '
PERF SCRIBE,VARIUS
B UNST090 INVALID DEVICE, READ AGAIN
UNST030
POWER FAILURE OCCURRED.
DOWNLINELOAD SCREENS ETC.
MOVE BIN1,COB13 SET HEADER LENGTH
MOVE WKSTG2,HEADER
UNST031
MOVE LENGTH,=W'256'
READ .NW,DSCMIP,BUFIN,LENGTH READ FOR ALARMS
DELAY COB10 WAIT 1 SEC
ABORT DSCMIP ABORT READ
BOK UNST032 READ NOT COMPLETE?
WAIT DSCMIP
B UNST031 READ AGAIN
UNST032
PERF LOADER DOWNLINELOAD PARAMTERS ETC
BOK UNST034
MOVE VARIOUS,=C'ERROR DURING DOWN-LINE LOADING '
PERF SCRIBE,VARIUS
UNST033
B UNST030 TRY AGAIN
UNST034
MOVE WKSTR7,=C'3' CONFIG.DATA
PERF OPRCMD OPERATIONAL COMMAND
BNOK UNST030
MOVE WKSTR7,=C'1'
PERF OPRCMD SEND OPEN COMMAND
B UNST090
UNST040 ALARM
UNST045 PRINTERS
UNST050 CARD READER
UNST055 CONTROL PANEL
UNST060 CARD WRITER
UNST065 VANDAL SHIELD
B UNST090
UNST070 KEYS
MOVE WKSTR7,=C'3' CONFIG.DATA
PERF OPRCMD OPERATIONAL COMMAND
BNOK UNST090
MOVE RETUR,COB0 SOLL.STATUS EXPECTED
RET
UNST090
MOVE RETUR,COB1
RET
PEND
EJECT
SENDFC PROC
*
****** SEND FUNCTION COMMAND
*
MOVE PNT1,COB0 POINTER WITHIN FCBLD
COPY OPKY,COB0,COB8,FCBLD(FCBLDX),COB0 COPY OPERATION KEYS
ADD PNT1,COB8
**********************************************************
FC1 BUILD FUNCTION COMMAND
MOVE FCMESS,=X'4131201B3142341C1C1C20' LOAD STANDARD HEADER
MOVE PNT3,=W'10' SET PNT3 TO FIRST FREE
BYTE IN FCMESS
**********************************************************
NEXT STATE
COPY FCMESS,PNT3,COB3,FCBLD(FCBLDX),PNT1 COPY STATE TO FCMESS
ADD PNT3,COB3 INCREMENT FCMESS POINTER
ADD PNT1,COB3 INCREMENT FCBLD POINTER
**********************************************************
FC2 LOAD FS.
COPY FCMESS,PNT3,COB1,FS,COB0 COPY FS. TO FCMESS
ADD PNT3,COB1 INCREMENT FCMESS POINTER
**********************************************************
COPY FCMESS,PNT3,COB16,NOTES,COB0 LOAD NOTES
ADD PNT3,=W'16' INCREMENT FCMESS POINTER
**********************************************************
FC4 LOAD FS.
COPY FCMESS,PNT3,COB1,FS,COB0 COPY FS TO FCMESS
ADD PNT3,COB1 INCREMENT FCMESS POINTER
**********************************************************
TRANSACTION SERIAL NUMBER
MOVE WKB1,=W'27' POINT AT AFFECTED SERIALNUMBER
XCOPY WKSTR7,COB0,COB1,FCBLD(FCBLDX),WKB1 COPY IT
MOVE WKBCD1,WKSTR7 CONVERT TO BCD
MOVE WKB1,WKBCD1 CONVERT TO BIN
ADD SRLNBR(WKB1),=D'1' INCREMENT SERIAL NUNBER
EDIT WKSTG4,SRLFMT EDIT IT
COPY FCMESS,PNT3,COB4,WKSTG4,COB0
ADD PNT3,COB4 INCREMENT FCMESS POINTER
**********************************************************
FUNCTION ID
COPY FCMESS,PNT3,COB1,FCBLD(FCBLDX),PNT1 COPY FUNCTION ID
ADD PNT3,COB1 INCREMENT FCMESS POINTER
ADD PNT1,COB1 INCREMENT FCBLD POINTER
**********************************************************
SCREEN NUMBER
COPY FCMESS,PNT3,COB3,FCBLD(FCBLDX),PNT1 COPY SCREEN NO
ADD PNT3,COB3 INCREMENT FCMESS POINTER
ADD PNT1,COB3 INCREMENT FCBLD POINTER
**********************************************************
XCOPY WKSTG4,COB0,COB4,FCBLD(FCBLDX),PNT1 EXTRACT FID+SCREEN
ADD PNT1,COB4 INCREMENT FCBLD POINTER
CBE WKSTG4,=C'0000',FC4A NO FID+SCREEN
COPY FCMESS,PNT3,COB1,GS,COB0 <GS>
ADD PNT3,COB1 INCREMENT FCMESS POINTER
COPY FCMESS,PNT3,COB4,WKSTG4,COB0 FID+SCREEN
ADD PNT3,COB4 INCREMENT FCMESS POINTER
FC4A
XCOPY WKSTG4,COB0,COB4,FCBLD(FCBLDX),PNT1
ADD PNT1,COB4 INCREMENT FCBLD POINTER
CBE WKSTG4,=C'0000',FC4B NO FID+SCREEN
COPY FCMESS,PNT3,COB1,GS,COB0
ADD PNT3,COB1
COPY FCMESS,PNT3,COB4,WKSTG4,COB0 FID+SCREEN
ADD PNT3,COB4
FC4B
**********************************************************
FC5 LOAD FS.
COPY FCMESS,PNT3,COB1,FS,COB0 COPY FS. TO FCMESS
ADD PNT3,COB1 INCREMENT FCMESS POINTER
**********************************************************
MESSAGE COORDINATION NUMBER
COPY FCMESS,PNT3,COB1,MESS,COB0 COPY MESSAGE CO-ORD NUMBER
ADD PNT3,COB1 INCREMENT FCMESS POINTER
**********************************************************
CARD RETURN/RETAIN FLAG
COPY FCMESS,PNT3,COB1,FCBLD(FCBLDX),PNT1 COPY CARD'HOLD'FLAG
ADD PNT3,COB1 INCREMENT FCMESS POINTER
ADD PNT1,COB1 INCREMENT FCBLD POINTER
**********************************************************
PRINTER FLAG
COPY FCMESS,PNT3,COB1,FCBLD(FCBLDX),PNT1 COPY PRINTER FLAG
COPY WKSTR7,COB0,COB1,FCBLD(FCBLDX),PNT1
ADD PNT3,COB1 INCREMENT FCMESS POINTER
ADD PNT1,COB1 INCREMENT FCBLD POINTER
**********************************************************
PRINTER DATA POINTER
CBE WKSTR7,=C'0',FCP90 NO PRINTER FLAG
* RECEIPT PRINTER
CBNE TXFG,=C'1',FCP10
* EDIT HEADER ONLY IF FIRST TRANSACTION ON SLIP
MOVE FMBUF,=X'00'
GETTIME KL HENT KLOKKEN
EDIT FMBUF,DATEFMT
MOVE BIN7,COB0
MOVE BIN6,=W'256'
MOVE WKSTR7,=X'00'
MATCH FMBUF,BIN7,BIN6,WKSTR7,COB0,COB1
XCOPY FCMESS,PNT3,BIN7,FMBUF,COB0
ADD PNT3,BIN7
MOVE COUNT,PLEN(COB1,COB2) SET LINELENGTH
XCOPY FCMESS,PNT3,COUNT,PNAT(COB1),COB0 "THANK YOU ..."
ADD PNT3,COUNT INCREMENT FCMESS POINTER
FCP10
XCOPY WKSTR8,COB0,COB2,FCBLD(FCBLDX),PNT1 FORMAT NBR
ADD PNT1,COB2 INCREMENT FCBLD POINTER
CBE WKSTR8,=C'00',FCP30 USE PTAB/PLEN
MOVE WKBCD1,WKSTR8
MOVE BIN7,WKBCD1
MOVE FMBUF,=X'00'
EDIT FMBUF,FORMATS(BIN7) = FORMATS(SCREENNBR)
MOVE BIN6,COB0
MOVE WKSTR7,=X'00'
MOVE BIN7,=W'256' LENGTH FMBUF
MATCH FMBUF,BIN6,BIN7,WKSTR7,COB0,COB1
XCOPY FCMESS,PNT3,BIN6,FMBUF,COB0 MOVE ONLY GOOD LENGTH
ADD PNT3,BIN6
B FCP90
FCP30
MOVE BIN7,PLEN(FCBLDX,COB1) PRINTERDATALENGTH
CBE BIN7,COB0,FCP90 NOT IF ZERO LENGTH
XCOPY FCMESS,PNT3,BIN7,PTAB(FCBLDX),COB0 MOVE PRINTERDATA
ADD PNT3,BIN7
FCP90
**********************************************************
B FC9 T E M P O R A R Y
TEST TRACK 3 DATA FLAG
MOVE BIN1,PNT1 USE DUMMY POINTER
**********************************************************
MATCH FCBLD(FCBLDX),BIN1,COB1,WKSTG1,COB0,COB1 TEST FG NOT SET
BZ FC9 FLAG NOT SET. SEND FCMESS
**********************************************************
TEST TRACK 3 DATA LENGTH
CBE TK3DL,COB0,FC9 TEST LENGTH TK3 DATA RECEIVED
LOAD FS + GRAPHIC 4
MOVE WKSTG1,=X'1C34' CODE - FS. + GRAPHIC 4
COPY FCMESS,PNT3,COB2,WKSTG1,COB0 WRITE FS. + '4' TO FCMESS
ADD PNT3,COB2 INCREMENT FCMESS POINTER
**********************************************************
TEST TRACK 3 DATA FLAG
MOVE WKSTG1,=X'02' CODE - TK3 DATA FG =:02
MOVE BIN1,PNT1 USE DUMMY POINTER
MATCH FCBLD(FCBLDX),BIN1,COB1,WKSTG1,COB0,COB1 TEST TK3D FLAG
BNZ FC8 FLAG NOT SET TO :02
SEND TRACK 3 DATA AS RECEIVED
**********************************************************
TRACK 3 UPDATE POINTER
ADD PNT1,COB2 SET PNT1 TO TRACK 3 U/D INDEX
XCOPY PDX,COB1,COB1,FCBLD(FCBLDX),PNT1 LOAD PDX WITH TRACK 3
UPDATE POINTER
XCOPY PNT2,COB0,COB2,PDUOFF(PDX),COB0 POOL OFFSET -> PNT2
XCOPY COUNT,COB1,COB1,PDUOFF(PDX),COB2 DATA LENGTH -> COUNT
**********************************************************
TEST EXTENT OF UPDATE
SUB PNT1,COB1 PNT1 TO TK3 U/D OFFSET INDEX
MOVE BIN3,COB0 CLEAR BIN3
XCOPY BIN3,COB1,COB1,FCBLD(FCBLDX),PNT1 COPY TK3 U/D OFFSET
ADD BIN3,COUNT ADD U/D LENGTH TO U/D OFFSET
CBL BIN3,TK3DL,FC7 TEST U/D NOT< TK3 DATA LENGTH
MOVE VARIOUS,=C'TRACK 3 UPDATE ABORTED '
PERF SCRIBE,VARIUS
B FC8 SEND TK3 DATA AS RECEIVED
**********************************************************
FC7 UPDATE TRACK 3 DATA
SUB BIN3,COUNT RESET TRACK 3 U/D OFFSET
COPY TK3D,BIN3,COUNT,POOL,PNT2 UPDATE TRACK 3 DATA
FC8 SEND TRACK 3 DATA
COPY FCMESS,PNT3,TK3DL,TK3D,COB0 LOAD TRACK 3 DATA
ADD PNT3,TK3DL SET PNT3 TO MESSAGE LENGTH
**********************************************************
FC9 WRITE FUNCTION COMMAND
WRITE DSCMOP,FCMESS,PNT3 WRITE MESSAGE TO LINE
XSTAT DSCMOP,BIN3 COPY STATUS TO BIN3
PERF RECHK EXAMINE STATUS
IB BIN2, CHECK AND BRANCH ON INDEX C
FC10, READ OK C
FC11, MODEM NOT OPERABLE C
FC11, LINE CLOSED C
FC11, ATM INACTIVE C
FC10, RETRANSMISSIONS PERFORMED C
FC11, INVALID TC FOR WRITE C
FC11, POLL HALTED FOR READ C
FC11 ATM BUSY FOR WRITE
FC10 FUNCTION COMMAND SENT
SET RESFG SET RESPONSE EXPECTED FLAG
PERF SCRIBE,FCSENT 'FUNCTION COMMAND SENT (KEYS)'
B SFC010
FC11 WRITE ERROR
MOVE STATUS,BIN3 COPY STATUS TO BCD FIELD
PERF SCRIBE,DCWE 'DATA COMM WRITE ERROR-STATUS'
SFC010
MOVE RETUR,COB0
RET
PEND
EJECT
*
****** OPL OPEN/CLOSE LINE
*
* FUNCTION:-
* THIS SUBROUTINE OPENS AND CLOSES THE LINE TO THE AT
*
* CALLING SEQUENCE:-
* PERF OPL
*
* ENTRY:-
* THE FOLLOWING PARAMETERS ARE SET UP BEFORE CALLING
* THE SUBROUTINE:-
* BIN2 -- '00A2' OPEN LINE
* -- '00A4' CLOSE LINE
* ADR -- '0041' ATM ADDRESS
*
* EXIT:-
* THE ROUTINE WILL SET THE INDEX VALUE IN BIN3
* THE VALUE IS AS FOLLOWS:-
* 0 ILLEGAL/UNRECOGNISABLE ERROR
* 1 I/O OK
* 2 MODEM NOT OPERABLE
* 3 LINE ALREADY OPEN
* THE ROUTINE WILL ALSO UPDATE ATM LINE STATUS AND SET
* THE TABLE AS FOLLOWS:-
* 0 LINE TO ATM OK
* 1 MODEM INOPERABLE
OPL PROC
CALL RECASM,DSCMOP,BIN2,ADR,BIN3 PERFORM I/O ON LINE
CBNE BIN2,=X'00A2',OP5 TEST FOR CLOSE LINE CODE
IB BIN3, INDEX FROM ASS. SUBROUTINE C
OP2, LINE OK C
OP3, MODEM NOT OPERABLE C
OP2 LINE ALREADY OPEN
B OP6 ILLEGAL ERROR
OP2 MOVE BIN1,=W'0' SET CODE FOR LINE OPEN
B OP6
OP3 MOVE BIN1,=W'1' SET CODE FOR LINE NOT OPERABLE
B OP6
OP5 IB BIN3, INDEX FROM ASS. SUBROUTINE C C
OP7, LINE CLOSED C
OP6, N/A C
OP6 LINE ALREADY CLOSED
OP6 RET
OP7
CLEAR OPEN
B OP3
PEND
EJECT
*
****** RECHK CONVERTS A RETURN CODE INTO
* AN INDEX
*
*
* FUNCTION:-
* THIS ROUTINE CONVERTS A GIVEN RETURN CODE INTO AN
* INDEX VALUE AS FOLLOWS:-
* 1. I/O OK
* 2. MODEM NOT OPERABLE
* 3. LINE CLOSED
* 4. ATM INACTIVE
* 5. RETX
* 6. INVALID TC FOR WRITE
* POLL LIST OVERFLOW
* 7. POLL HALTED FOR READ
* 8. ATM BUSY FOR WRITE
* ATM ACTIVE FOR READ
*
* ENTRY:-
* THIS ROUTINE MUST HAVE A RETURN CODE IN BIN3
*
* EXIT:-
* BIN2 CONTAINS THE INDEX VALUE AS ABOVE
* BIN3 REMAINS UNCHANGED
*
RECHK PROC
MOVE BIN2,COB1 SET INDEX TO 1
CBE BIN3,COB0,R90 I/O OK?
ADD BIN2,COB1 INCREMENT INDEX (II)
CBE BIN3,COB1,R90 MODEM NOT OPERABLE
ADD BIN2,COB1 II
CBE BIN3,=X'0010',R90 LINE CLOSED
ADD BIN2,COB1 II
CBE BIN3,=X'0020',R90 ATM INACTIVE
ADD BIN2,COB1 II
CBE BIN3,=X'0100',R90 RETX
ADD BIN2,COB1 II
CBE BIN3,COB8,R90 POLL LIST OVERFLOW
CBE BIN3,=X'0040',R90 ATM NOT IN POLL LIST
ADD BIN2,COB1 II
CBE BIN3,=X'0080',R90 POLLING HALTED
ADD BIN2,COB1 ATM BUSY
R90 RET
PEND
EJECT
****** SCRIBE WRITES TO THE DISPLAY
*
* FUNCTION:-
* THIS SUBROUTINE WRITES TO THE DISPLAY AND REPORTS
* ON ANY DEVICE STATUS ERRORS
*
* ENTRY:-
* THE FORMAT NAME IS CARRIED INTO THE SUBROUTINE
*
* CALLING SEQUENCE:-
* PERF SCRIBE,FRMAT,DISPLAY
* SCRIBE PROC FRMAT,DISPLAY
*
* EXIT:-
* 1. WITH I/O OK,NORMAL RETURN.
* 2. ELSE STOP
SCRIBE PROC FRMAT
PFRMT FRMAT
EDWRT DY,FRMAT
BERR S1 TEST FOR ERROR
RET
S1
B S1
EXIT
PEND
EJECT
*
****** UNLOAD UNLOADS MESSAGE DATA
*
* FUNCTION:-
* THIS SUBROUTINE EXAMINES THE MESSAGE AND
* UNLOADS THE DATA FIELDS INTO SEPARATE WORK SPACES.
* INITALLY IT WILL CLEAR THE WORK SPACE AND ZEROISE
* THE POINTER.
* WHEN A FIELD SEPARATOR IS FOUND, IT EXAMINES THE
* LENGTH OF THE DATA FIELD. IF THIS IS NON-ZERO, IT
* COPIES THE DATA INTO THE APPROPRIATE WORK SPACE AND
* DELETES ALL CHARACTERS UPTO AND INCLUDING THE FIELD
* SEPERATOR. SHOULD THE LENGTH OF THE FIELD SEPARATOR
* IT DELETES THE FIELD SEPERATOR, AND SETS A FLAG WHICH
* WILL BE TESTED WHEN THE INFORMATION IS DISPLAYED.
*
* ENTRY:-
* THE WORKSPACE NAME IS CARRIED INTO THE SUBROUTINE
* AND A BOOLEAN FLAG.
*
* CALLING SEQUENCE:-
* PERF UNLOAD,<FIELD>,<FLAG>,<LENGTH>
* UNLOAD PROC FIELD,FLAG,LENGTH
*
* EXIT:-
* THE ROUTINE WILL RETURN TO THE MAIN PROGRAM VIA RET
*
UNLOAD PROC FIELD,FLAG,LEN
PSTRG FIELD
PBOOL FLAG
PLIT LEN
MOVE PNT1,COB0 SET POINTER TO ZERO
MOVE FIELD,=C' ' CLEAR FIELD
MATCH BUFIN,PNT1,LENGTH,FS,COB0,COB1 SEARCH FOR FS
CBE PNT1,COB0,UL1 CHECK INFORMATION LENGTH
CBNG PNT1,LEN,UL0
MOVE PNT1,LEN DELIMIT TO EXPLICIT LENGTH
UL0
XCOPY FIELD,COB0,PNT1,BUFIN,COB0 COPY INFORMATION INTO FIELD
UL1 ADD PNT1,COB1 ADD 1 TO POINTER
DLETE BUFIN,COB0,PNT1 DELETE UPTO FIELD SEPARATOR
CBNE PNT1,COB1,UL2 TEST FOR DATA LENGTH =0
SET FLAG SET ZERO LENGTH FLAG
UL2 RET
PEND
EJECT
**
** DLLATM
** ------
**
** THIS ROUTINE INSERTS A PROTOCOL/MESSAGE HEADER AT THE START
** OF THE DC BUFFER WRITES THE BUFFER TO THE ATM AND READS THE
** ATM'S RESPONSE.
** IF ANY DC ERROR OCCURS OR IF THE ATM DOES NOT RESPOND WITH
** A READY SOLICITED STATUS, THE ROUTINE EXITS WITH CR =2.
**
**
DLLATM PROC
INSRT BUFIN,COB0,COB13,WKSTG2,COB0 INSERT HEADER
ADD LENGTH,COB13 UPDATE MESSAGE LENGTH
SUB LENGTH,COB1 IGNORE TRAILING FIELD SEPR.
WRITE DSCMOP,BUFIN,LENGTH SEND MESSAGE TO ATM
XSTAT DSCMOP,BIN3 GET EXTENDED STATUS
PERF RECHK CONVERT TO INDEX
CBE BIN2,COB1,DLL100 WRITE OK?
CBE BIN2,COB5,DLL100 RETRIES PERFORMED?
MOVE STATUS,BIN3 CONVERT XSTAT TO BCD
PERF SCRIBE,DCWE O/P DC WRITE ERROR
DLL050
CMP COB0,COB1 SET CONDITION REG TO 2
RET
DLL100
MOVE LENGTH,=W'256'
READ DSCMIP,BUFIN,LENGTH READ FOR RESPONSE
XSTAT DSCMIP,BIN3 GET EXTENDED STATUS
PERF RECHK CONVERT TO INDEX
CBE BIN2,COB1,DLL150 READ OK?
MOVE STATUS,BIN2 CONVERT XSTAT TO BCD
PERF SCRIBE,DATAER 'DC READ ERROR'
B DLL050
DLL150
MOVE WKSTG1,=X'32321C3030301C1C39' SET UP READY PATTERN
MOVE BIN2,COB4 INIT MATCH
MATCH BUFIN,BIN2,COB9,WKSTG1,COB0,COB9
SEARCH FOR READY PATTERN
BNERR DLL200 READY RECEIVED
MOVE WKSTG1,=X'3132' KEYLOCKS OR ALARMS
MOVE BIN2,COB7
MATCH BUFIN,BIN2,COB2,WKSTG1,COB0,COB2
BNERR DLL100 DISREGARD THOSE THINGS
MOVE VARIOUS,=C'INVALID MESSAGE RECEIVED '
PERF SCRIBE,VARIUS
B DLL050
DLL200
CMP COB0,COB0 SET CONDITION REG TO 0
RET
PEND
EJECT
KBINP PROC
DSC KB,X'02' SKIP BUFFER
MOVE LENGTH,COB9
KI KB,BUFIN,KTAB1,LENGTH,INDEX READ DATA
RET
PEND
KINW PROC
DSC KB,X'02'
MOVE KILN,COB1
KI .NW,KB,KIBUF,KTAB1,KILN,KIIX
RET
PEND
DCNW PROC
MOVE BUFIN,=C' ' CLEAR BUFIN
MOVE LENGTH,=W'256' SET LENGTH TO 256
READ .NW,DSCMIP,BUFIN,LENGTH READ LINE MESSAGE FROM ATM
RET
PEND
EJECT
OPRCMD PROC
*
* THIS ROUTINE SENDS AN OPERATIONAL COMMAND AND WAITS FOR THE ANSWER
* IT NEEDS A PARAMTER IN WKSTR7
* 1 - OPEN
* 2 - CLOSE
* 3 - CONFIG.DATA
*
PERF SCRIBE,FMCMD
EDIT BUFIN,OPCMD
MOVE LENGTH,COB11
WRITE DSCMOP,BUFIN,LENGTH SEND MESSAGE TO ATM
XSTAT DSCMOP,BIN3 GET EXTENDED STATUS
PERF RECHK CONVERT TO INDEX
CBE BIN2,COB1,OPRC010 OK?
CBE BIN2,COB5,OPRC010 RETRIES?
MOVE STATUS,BIN3 CONVERT XSTAT TO BCD
PERF SCRIBE,DCWE O/P DC WRITE ERROR
CMP COB0,COB1
RET
*
OPRC010
MOVE LENGTH,=W'256'
MOVE BUFIN,=C' '
READ DSCMIP,BUFIN,LENGTH READ FOR RESPONSE
XSTAT DSCMIP,BIN3 GET EXTENDED STATUS
PERF RECHK CONVERT TO INDEX
CBE BIN2,COB1,OPRC020 OK?
MOVE STATUS,BIN2 CONVERT XSTAT TO BCD
PERF SCRIBE,DATAER 'DC READ ERROR'
OPRC015
CMP COB0,COB1 NOT OK
RET
*
OPRC020
*
MOVE WKSTR8,=X'1D44' GROUP SEP. + "D"
MOVE BIN3,LENGTH
SUB BIN3,COB1
MOVE BIN4,COB0
MATCH BUFIN,BIN4,BIN3,WKSTR8,COB0,COB2
BERR OPRC050 NOT FOUND, NORMAL RETURN
ADD BIN4,COB2 POINT TO 1. CASS.STAT
MOVE BIN5,COB0 LOOP CONTROL
OPRC040
ADD BIN5,COB1
CBG BIN5,COB4,OPRC050
XCOPY WKSTR8,COB0,COB2,BUFIN,BIN4 MOVE DENOM TO CASTAT
COPY WKSTR7,COB0,COB1,WKSTR8,COB1 IF NO CASSETTE
CBNE WKSTR7,=C'0',OPRC042 PRESENT, THEN FORCE
MOVE WKSTR8,=X'3E30' LOW-NOTE-CONDITION
OPRC042
CALL COPY4,CASTAT(COB1,BIN5),COB3,COB1, C
WKSTR8,COB3
MOVE BIN3,COB0
CALL COPY4,BIN3,COB3,COB1,WKSTR8,COB1
MOVE CASTAT(COB2,BIN5),COB0 RESET FIRST
CBNE BIN3,=X'000E',OPRC045
MOVE CASTAT(COB2,BIN5),COB1 INDICATE LOW NOTES
OPRC045
ADD BIN4,COB2 NEXT FEEDER
B OPRC040
OPRC050
CMP COB0,COB0
RET
PEND
EJECT
NOTMIX PROC
* COMPUTE NOTEMIX
MOVE WKB2A,COB9
MOVE WKD12A,PBCD
NOT100
SUB WKB2A,COB1 STEP INDEX
CBL WKB2A,COB1,NOT130 WRONG INPUT
PERF DENCK DENOMINATION CHECK
B NOT100 NOT AVAILABLE
CBG DENOM(WKB2A),WKD12A,NOT100 NEXT HIGHER
MOVE WKD3A,=D'0'
NOT110
CBL WKD12A,DENOM(WKB2A),NOT120 FINISHED?
SUB WKD12A,DENOM(WKB2A) 1 NOTE
SUB BEHOLDN(WKB2A,COB1),DENOM(WKB2A)
ADD BEHOLDN(WKB2A,COB2),DENOM(WKB2A) MONEY PAID
ADD WKD3A,=D'1'
B NOT110
NOT120
MOVE WKB2B,WKB2A CREATE INDEX
SUB WKB2B,COB1
ADD WKB2B,WKB2B
MOVE WKS4A,WKD3A CONVERT TO ASCII
COPY NOTES,WKB2B,COB2,WKS4A,COB2
CBE WKD12A,=D'0',NOT900 FINISHED?
B NOT100
NOT130
CMP COB0,COB1
RET
NOT900
CMP COB0,COB0
RET
PEND
EJECT
DENCK PROC
* CHECK EXISTANCE AND STATUS OF DENOMINATION
* WHICH INDEX IS GIVEN IN WKB2A
MOVE WKB2B,COB0
DENCK2
ADD WKB2B,COB1
CBG WKB2B,COB4,DENCK4
CBNE CASTAT(COB1,WKB2B),WKB2A,DENCK2
CBE CASTAT(COB2,WKB2B),COB1,DENCK2 LOW NOTES?
RET 2
DENCK4
RET
PEND
EJECT
LOMULT PROC
*
* THE PROCEDURE CHECKS THAT THE AMOUNT REQUIESTED IS A MULTIPLE
* OF THE LOWEST ACCESSIBLE DENOMINATION
*
MOVE WKD12A,PBCD
PERF FNDLOW GET INDEX TO LOWEST
B LOMUL9 NOTHING ACCESSIBLE
MOVE WKD12B,DENOM(WKB2B) LOWEST DENOMINATION
LOMUL2
DIV WKD12A,WKD12B
MUL WKD12A,WKD12B
CBNE WKD12A,PBCD,LOMUL9 ANY REMAINDER?
CMP COB0,COB0 NO THERE WASNT
RET
LOMUL9
CMP COB0,COB1 REMAINDER OR UNAVAILABLE
RET
PEND
FNDLOW PROC
* THE ROUTINE FINDS THE LOWEST DENOMINATION
MOVE WKB2A,COB0
MOVE WKB2B,COB8
FNDL10
ADD WKB2A,COB1
CBG WKB2A,COB4,FNDL20 DENOM EXHAUSTED
CBE CASTAT(COB1,WKB2A),COB0,FNDL10 NO CASSETTE
CBE CASTAT(COB2,WKB2A),COB1,FNDL10 LOW NOTES
CBNL CASTAT(COB1,WKB2A),WKB2B,FNDL10 NOT LOWEST
MOVE WKB2B,CASTAT(COB1,WKB2A) LOWEST SO FAR
B FNDL10
FNDL20
CBNE WKB2B,COB8,FNDL30 AT LEAST ONE AVAILABLE
RET NOTHING AVAILABLE
FNDL30
RET 2
PEND
EJECT
POLL FRMT
FCOPY ='22'
FCOPY ='POLLING '
FCOPY ='MICROBANK'
FMEND
INACT FRMT
FCOPY ='22'
FCOPY ='MICROBANK'
FCOPY =' NOT'
FCOPY =' RESPONDING TO POLL'
FMEND
DATAER FRMT
FTEXT '22DATA COMM READ ERROR : '
FMEL '9999',STATUS
FMEND
INF FRMT
FCOPY =C'22'
FCOPY INFO
FMEND
DATEFMT FRMT
FMEL '99V99V99',DATE
FILLR ' ',1
FCOPY KL
FILLR X'0A',3
FMEND
CUSTRQ FRMT
FTEXT '00CUSTOMER REQUEST'
FNL
FTEXT 'OP KEYS: '
FBT F4,CUS1
FCOPY OPKY
FB CUS2
CUS1 FTEXT ' NONE '
CUS2 FILLR ' ',2
FTEXT '1ST TRANS: '
FCOPY TXFG
FILLR ' ',2
FTEXT 'MESS.CO-ORD NO: '
FCOPY MESS
FILLR ' ',2
FBT F5,CUS3
FTEXT 'DOLLAR AMOUNT: '
FMEL 'ZZZZZZZ9V99',PBCD
CUS3 FNL
FBT F6,CUS4
FTEXT 'GP BUFFER A: '
FCOPY GPBA
FNL
CUS4 FBT F7,CUS5
FTEXT 'GP BUFFER B: '
FCOPY GPBB
FNL
CUS5 FBT F8,CUS6
FTEXT 'AMOUNT: '
FCOPY GPBC
FNL
CUS6 FBT F9,CUS7
FTEXT 'TRACK 1 DATA: '
FCOPY TK1D1
FNL
FILLR ' ',14
FCOPY TK1D2
FNL
CUS7 FBT F2,CUS8
FTEXT 'TRACK 2 DATA: '
FCOPY TK2D
FNL
CUS8 FBT F3,CUS9
FTEXT 'TRACK 3 DATA: '
FCOPY TK3D1
FNL
FILLR ' ',14
FCOPY TK3D2
CUS9 FMEND
AMTERR FRMT
FTEXT '22'
FCOPY ='AMOUNT ERROR. TRANSACTION CANCELLED.'
FMEND
UNSS FRMT
FTEXT '22UNSOLICITED STATUS : '
FCOPY DEVAR2(DID)
FCOPY DEVST
FMEND
FCSENT FRMT
FTEXT '22FUNCTION COMMAND SENT ('
FCOPY OPKY
FTEXT ')'
FMEND
DCWE FRMT
FTEXT '22DATA COMM WRITE ERROR : '
FMEL '9999',STATUS
FMEND
SRLFMT FRMT
FMEL '9999',SRLNBR(WKB1)
FMEND
FCMD FRMT
FCOPY ='22'
FTEXT 'INVALID FUNCTION COMMAND'
FMEND
VARIUS FRMT
FCOPY ='22'
FCOPY VARIOUS
FMEND
OPCMD FRMT
FCOPY =X'4131201B3142'
FCOPY =X'311C1C1C'
FCOPY WKSTR7
FMEND
FMCMD FRMT
FCOPY ='22'
FTEXT 'FUNCTIONAL COMMAND '
FCOPY WKSTR7
FTEXT ' SENT '
FMEND
FORMATS FTABLE FMT1,FMT2,FMT3,FMT4,FMT5,FMT6,FMT7,FMT8,FMT9
FMT1 FRMT
FTEXT 'WDR '
FCOPY WKSTG4
FMEL '********9',PBCD
FTEXT ',00 '
FILLR X'0A',1
FMEND
FMT2 FRMT
FTEXT 'DEP '
FCOPY WKSTG4
FMEL '********9,99-',PBCD
FILLR X'0A',1
FMEND
FMT3 FRMT
FTEXT 'ENQ '
FCOPY WKSTG4
FILLR X'0A',1
FMEND
FMT4 FRMT
FILLR X'0A',1
FMEND
FMT5 FRMT
FILLR '*',25
FILLR X'0A',1
FMEND
FMT6 FRMT
FILLR '*',25
FILLR X'0A',1
FMEND
FMT7 FRMT
FILLR X'0C',1
FMEND
FMT8 FRMT
FILLR '*',25
FILLR X'0A',1
FTEXT 'BEHOLDNING/UTLEVERT'
FILLR X'0A',2
FILLR '1',1
FMEL '*********9',BEHOLDN(COB1,COB1)
FILLR '/',1
FMEL '*********9',BEHOLDN(COB1,COB2)
FILLR X'0A',2
FILLR '2',1
FMEL '*********9',BEHOLDN(COB2,COB1)
FILLR '/',1
FMEL '*********9',BEHOLDN(COB2,COB2)
FILLR X'0A',2
FILLR '*',25
FILLR X'0A',1
FMEND
FMT9 FRMT
FILLR '*',25
FILLR X'0A',1
FTEXT 'SJEKKHEFTET KAN HENTES'
FILLR X'0A',2
FTEXT 'VED HENVENDELSE I KASSE 1'
FILLR X'0A',2
FMEND
END