⟦a514d65f5⟧

PTS(SC)

 IDENT SCREEN 831026 EV 
			1.1,78-04-20,870138040310
* 
*    A STANDARD PROGRAM PACKAGE HANDLING
*    A COMPLETE PICTURE ON A DISPLAY SCREEN 
* 
*    RUNNING UNDER:  CREDIT REL 3.1 
*                    TOSS   REL 8.1 
* 
 DDUM KMD08 
 PDIV 
* 
 ENTRY SPCLRA CLEAR ALL VARIABLE FIELDS 
 ENTRY SPCLRS CLEAR SOME VARIABLE FIELDS
 ENTRY SPCLRN CLEAR NO VARIABLE FIELDS
 ENTRY SPERR DISPLAY ERROR PRINTOUT 
			AND CONTINUE HANDLING
	ENTRY	SPLIN8	MESSAGE ON LINE 8 
	ENTRY	SPCA	AS SPCLRA-- 
	ENTRY	SPCN	AS SPCLRN-- 
			SPCA AND SPCN ARE ONLY ACTIVE
			BETWEEN LINES
			SPLINTOP AND SPLINLOW
 ENTRY SCREEN 
	ENTRY	SPINF1	INFORMATION ON LINE 1 
 ENTRY BELL 
 ENTRY KBTEST 
 ENTRY DKTEST 
 EXT SPCHK1 STANDARD CHECK ROUTINE NO. 1
 EXT SPCHK2 STANDARD CHECK ROUTINE NO. 2
 EXT SPCHK3 STANDARD CHECK ROUTINE NO. 3
 EXT SPCHK4 STANDARD CHECK ROUTINE NO. 4
 EXT SPCHK5 STANDARD CHECK ROUTINE NO. 5
 EXT SPCHK6 STANDARD CHECK ROUTINE NO. 6
 EXT SPCHK7 STANDARD CHECK ROUTINE NO. 7
 EXT SPAPPL USER ROUTINE TO HANDLE
			APPL VALUES
 EXT SPTCHK USER ROUTINE TO EVALUATE
			CONDITIONAL TABULATION 
 EXT ABORT
	EXT	EMPTYT	ASSEMBLY SUBROUTINE EMPTYT  - 
			TEST IF DATA ITEM IS EMPTY 
	EXT	CLEAR8 
* 
NOKEY EQU X'FF' 
BSPKY1 EQU X'A7'
CANKY1 EQU X'B2'
MACKY1 EQU X'8B'
EORKY1 EQU X'AB'
FTABKY1 EQU X'FF' 
BTABKY1 EQU X'AA' 
DUPKY1 EQU X'B3'
SLUTKY1 EQU X'A5' 
REGKY1 EQU X'A1'
COPKY1 EQU X'B5'
EDTKY1 EQU X'FF'
KREKY1 EQU X'A2'
LISTKY1 EQU X'BD' 
SBTKY1 EQU X'BE'
SPGKY1 EQU X'99'
CY1KY1 EQU X'FF'
CY2KY1 EQU X'FF'
CYCKY1 EQU X'A3'
INVKY1 EQU X'9E'
KONKY1 EQU X'BF'
KVITKY1 EQU X'B5' 
SUPLKY1 EQU X'9D' 
SUMKY1 EQU X'9F'
ADMKY1 EQU X'A0'
DIVKY1 EQU X'9C'
HBOGKY1 EQU X'FF' 
DEBPKY1 EQU X'FF' 
REMKY1 EQU X'FF'
TRSEL EQU X'FF' 
ONKY1 EQU X'B6' 
SP1KY1 EQU X'9A'
A45KY1 EQU X'9B'
* 
FTBKY1 EQU X'AB'
BTBKY1 EQU X'AA'
INSKY1 EQU X'B0'
DELKY1 EQU X'B1'
CL1KY1 EQU X'80'
CL2KY1 EQU X'9A'
CL3KY1 EQU X'95'
OUTKY1 EQU X'A0'
* 
BSPKY2 EQU BSPKY1 
CANKY2 EQU CANKY1 
EORKY2 EQU EORKY1 
MACKY2 EQU MACKY1 
FTABKY2 EQU FTABKY1 
BTABKY2 EQU BTABKY1 
DUPKY2 EQU DUPKY1 
EDTKY2 EQU EDTKY1 
SLUTKY2 EQU SLUTKY1 
KREKY2 EQU KREKY1 
REGKY2 EQU REGKY1 
ADMKY2 EQU ADMKY1 
SPGKY2 EQU SPGKY1 
KONKY2 EQU KONKY1 
KVITKY2 EQU KVITKY1 
ONKY2 EQU ONKY1 
SP1KY2 EQU SP1KY1 
A45KY2 EQU A45KY1 
* 
*     FIRST INCLUDE KEY VALUES, 
*     THEN INCLUDE SPECIAL SCREEN FORMATS 
SPKTAB1 KTAB BSPKY1,CANKY1,NOKEY,EORKY1,NOKEY,MACKY1,		C
		FTABKY1,BTABKY1,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		COPKY1,DUPKY1,EDTKY1,SLUTKY1,		C
		KREKY1,REGKY2,LISTKY1,SBTKY1,SPGKY1,		C 
		CY1KY1,CY2KY1,INVKY1,KONKY1,KVITKY1,SUPLKY1,SUMKY1,		C
		ADMKY1,CYCKY1,DIVKY1,HBOGKY1,SP1KY1,REMKY1,TRSEL,		C
		ONKY1,A45KY1,NOKEY
* 
SPKTAB2 KTAB BSPKY1,CANKY1,NOKEY,EORKY1,NOKEY,MACKY1,		C
		FTABKY1,BTABKY1,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		COPKY1,NOKEY,EDTKY1,SLUTKY1,		C 
		KREKY1,NOKEY,NOKEY,NOKEY,NOKEY,		C
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		ADMKY1,CYCKY1,NOKEY,NOKEY,NOKEY,NOKEY,TRSEL,		C 
		NOKEY,A45KY1,NOKEY
* 
SPKTAB3	KTAB	FTBKY1,BTBKY1,INSKY1,DELKY1,		C
		CL1KY1,CL2KY1,CL3KY1,OUTKY1 
* 
SPKTAB12	KTAB	BSPKY2,CANKY2,NOKEY,EORKY2,NOKEY,MACKY2,		C 
		FTABKY2,BTABKY2,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,DUPKY2,EDTKY2,SLUTKY2,		C 
		KREKY2,REGKY2,ADMKY2,SPGKY2,KONKY2,KVITKY2,		C
		ONKY2,A45KY2
* 
SPKTAB22	KTAB	BSPKY2,CANKY2,NOKEY,EORKY2,NOKEY,MACKY2,		C 
		FTABKY2,BTABKY2,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,EDTKY2,SLUTKY2,		C
		KREKY2,NOKEY,ADMKY2,SPGKY2,KONKY2,KVITKY2,		C 
		ONKY2,A45KY2
* 
*          INQUIRY KEYTABLES (SPKEY=3)
* 
SPKTAB13 KTAB BSPKY1,NOKEY,CANKY1,NOKEY,NOKEY,MACKY1,		C
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,SLUTKY1,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,INVKY1,KONKY1,KVITKY1 
* 
SPKTAB23 KTAB BSPKY1,NOKEY,CANKY1,NOKEY,NOKEY,MACKY1,		C
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,NOKEY,		C 
		ADMKY1
* 
* 
SPFTBERR	FTABLE	ERRFMT,ERRFMT,ERRFMT,ERRFMT,ERRFMT,		C
		ERRFMT,ERRFMT,ERRFMT,ERRFMT,ERRFMT,		C
		ERRFMT,ERRFMT,ERRFMT,ERRFMT,ERRFMT,		C
		ERRFMT,ERRFMT,ERRFMT,ERRFMT,ERRFMT,		C
		ERRDSK,ERRFMT,ERRFMT,ERRFMT,ERRFMT,		C
		ERRFMT,ERRFMT,ERRFMT,ERRFMT,ERRFMT	WARNINGS 
* 
SPFTBMES	FTABLE	MSFMT1,MSFMT2,MSFMT3,MSFMT4,MSFMT5,MSFMT6,		C 
		MSFMT7,		C
		MSFMT8,		C
		MSFMT9,		C
		MSFMT10,		C 
		MSFMT11,		C 
		MSFMT12,		C 
		MSFMT13,		C 
		MSFMT14 
* 
* 
ERRFMT FRMT 
 FSL
	FCOPY	='FEJL ' 
	FMEL	'ZZ9',GSWBCD4	ERRORNR.
 FMEND
* 
ERRDSK	FRMT 
	FSL
	FMEL	'99B',GTWBCD2 
 FCOPY GSWSTR9
	FMEL	'99',GTWBCD1
	FMEND
* 
MSFMT1	FRMT 
	FSL
	FCOPY	='SKIFT JOURNAL' 
	FMEND
* 
MSFMT2	FRMT 
	FSL
  FCOPY  ='LINIE NR'
  FILLR  '.',1
	FMEND
* 
MSFMT3	FRMT 
	FSL
	FTEXT	='NY SIDE. ' 
	FMEND
* 
MSFMT4	FRMT 
	FSL
	FBF	TTSUMFLG,FMT4END 
	FTAB	15
	FCOPY	GTL8TXT
	FINP	23
	FMEL	'ZZZZZVZZ9,99+',GTSUM 
FMT4END 
	FMEND
* 
MSFMT5	FRMT 
	FSL
	FCOPY	='BILAG' 
	FMEND
* 
MSFMT6	FRMT 
	FSL
	FCOPY	='KONTOKORT' 
	FMEND
* 
MSFMT7	FRMT 
	FSL
	FCOPY	TTINF1 
	FMEND
* 
MSFMT8 FRMT 
 FSL
 FCOPY ='DISKETTE SKIFT ' 
 FILLR X'07',1
 FMEND
* 
MSFMT9 FRMT 
 FSL
 FCOPY ='OPSTART. ' 
 FCOPY ='AFVENT VENLIGST.'
 FMEND
* 
MSFMT10 FRMT
 FSL
 FMEL 'TTTTTTTTTTTT9-',GTWBCD2
 FMEND
* 
MSFMT11 FRMT
 FSL
*         FCOPY    ='OPRET LEV. ' 
 FMEND
* 
MSFMT12 FRMT
 FSL
 FMEND
* 
MSFMT13 FRMT
 FSL
*         FCOPY   ='STRAKS CHECK '
 FMEND
* 
MSFMT14 FRMT
 FSL
 FTEXT 'DISK STANDSET. '
 FCOPY ='AFVENT VENLIGST.'
 FILLR X'07',1
 FMEND
 EJECT
SPCLRA PROC 
* 
* SPCLRA - CLEAR ALL VARABLE FIELDS BEFORE HANDLING THE PICTURE 
* 
	MOVE	SPERASE,=W'0' 
	MOVE	SPLINTOP,=W'1'	WHOLE SCREEN 
	MOVE	SPLINLOW,=W'0'
	PERF	SCREEN,=W'1'
	RET
 PEND 
SPCLRS PROC 
* 
* SPCLRS - CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE 
* 
	MOVE	SPERASE,=W'0' 
	MOVE	SPLINTOP,=W'1'	WHOLE SCREEN 
	MOVE	SPLINLOW,=W'0'
	PERF	SCREEN,=W'2'
	RET
 PEND 
SPCLRN PROC 
* 
* SPCLRN - CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE 
* 
	MOVE	SPERASE,=W'0' 
	MOVE	SPLINTOP,=W'1'	WHOLE SCREEN 
	MOVE	SPLINLOW,=W'0'
	PERF	SCREEN,=W'3'
	RET
 PEND 
SPERR PROC
* 
* HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE
* 
	PERF	SCREEN,=W'0'
	RET
 PEND 
SPCA	PROC 
* 
* SPCA - AS SPCLRA, BUT ONLY BETWEEN LINES SPLINTOPAND SPLINLOW 
* 
	MOVE	SPERASE,=W'4' 
	PERF	SCREEN,=W'1'
	RET
	PEND 
SPCN	PROC 
* 
* SPCN - AS SPCLRN, BUT ONLY BETWEEN LINES SPLINTOP AND SPLINLOW
* 
	MOVE	SPERASE,=W'4' 
	PERF	SCREEN,=W'3'
	RET
	PEND 

SCREEN	PROC	$OPT
* 
* SCREEN SCREEN HANDLING MODULE 
* 
* CALL: PERF SCREEN,<$OPT>
* 
	PLIT	$OPT	OPTIO SELECTOR 

 CLEAR SPWARNFL CLEAR WARNING FLAG
	MOVE	SPBINW2,$OPT	MOVE TO VARIABLE 
			TO ALLOW INSTR.S CMP AND IB
	CMP	SPBINW2,='0'	"SPERR" ENTRY ? 
	BE	ERRPRINT	YES !

 TBT SPPROMPT,ENTIRE JUMP IF ENTIRE FORMAT
			SHOULD BE DISPLAYED
* 
*    ONLY VARIABLE FIELDS 
* 
 IB SPBINW2,CLEARA,CLEARS,CONT JUMP ON ROUTINE INDEX
* 
CLEARA
 ERASE 10,SPLINTOP,SPLINLOW ERASE ALL FROM 1 AND UP 
	THOME
 B CONT 
* 
CLEARS
 ERASE 5,SPLINTOP,SPLINLOW ERASE SOME FROM 1 AND UP 
	B	CONT 

*    DISPLAY ENTIRE FORMAT
ENTIRE
	IB	SPBINW2,ECLRA,ECLRS,ECLRN	JUMP ON ROUTINE INDEX 
*    CLEAR ALL VARIABLES
ECLRA 
	ERASE	11,SPLINTOP,SPLINLOW	CLEAR ALL 
			IN MEMORY
	B	ECLRN
* 
*    CLEAR SOME VARIABLES 
* 
ECLRS 
 ERASE 6,SPLINTOP,SPLINLOW CLEAR SOME FIELDS FROM 
			1 AND UP IN MEMORY 
*    CLEAR NO VARIABLES IN MEMORY 
ECLRN 
	IB	SPERASE,ECLRN1,ECLRN2,ECLRN3,ECLRN4 
	DISPLAY	0,SPLINTOP,SPLINLOW
	B	CONT 
ECLRN1
	DISPLAY	1,SPLINTOP,SPLINLOW
	B	CONT 
ECLRN2
	DISPLAY	2,SPLINTOP,SPLINLOW
	B	CONT 
ECLRN3
	DISPLAY	3,SPLINTOP,SPLINLOW
	B	CONT 
ECLRN4
	DISPLAY	4,SPLINTOP,SPLINLOW
CONT
 GETABX SPBINW4 GET CURRENT INDEX 
 BL KTHOME JUMP IF NO CURRENT FIELD 
CONT5 
 GETFLD 0,SPBINW4,SPBINW3 SEARCH CURRENT POSITION 
 BZ SETCREAD JUMP IF FOUND
 BL KTHOME POSITION NOT FOUND 
* 
*    COMPULSORY FIELD FOUND 
* 
 MOVE SPBINW4,SPBINW3 CHANGE INDEX
 B CONT5 SEARCH AGAIN 

* 
*    SET CURSOR AND READ KEYBOARD 
* 
SETCREAD
	SETCUR		SET CURSOR ON CURRENT FIELD

* 
*    READ TO CURRENT FIELD ON DISPLAY 
* 
READIN
*     SET FLAG IF AUTODUP 
*     USES VERIF-FIELD
	MOVE	SPBINW2,=W'3' 
	MOVE	SPBINW1,=W'1' 
	TSTCTL	6 
	BOK	DYKIN
 GETCTL 0,SPBINW3 
 MOVE SPBINW1,CFLTDEX(SPBINW3)
 CMP GSSWITCH(SPBINW1),CBIN0
 BE DYKIN 
 MOVE SPBINW1,CBIN1 
 BL DYK20 
 MOVE SPBINW2,CBIN15
	B	DYK20
* 
DYKIN 
	IB	SPKEY,DYK05,DYK10,DYK15 
DYK05 
 DYKI SPINPUT,SPKTAB1,SPKTAB2,SPBINW1,		C 
		SPBINW2,SPBINW4 
	B	DYKOUT 
DYK10 
	DYKI	SPINPUT,SPKTAB12,SPKTAB22,SPBINW1,		C 
		SPBINW2,SPBINW4 
 B DYKOUT 
DYK15 
 DYKI SPINPUT,SPKTAB13,SPKTAB23,SPBINW1,		C 
		SPBINW2,SPBINW4 
DYKOUT
 BL ERRPRT ERROR
	CLEAR	SPDUPL 
 CMP SPBINW2,=W'0'
 BE RETUR POWER OFF 
 BG DYK20 NORMAL
 ADD SPBINW2,=W'9' KEYSWITCH TURNED 
 IB SPBINW2,		C 
		SET1,SET2,SET3,SET4,CLR1,CLR2,CLR3,CLR4 
 B RETUR
SET1
 SET TTKEY1 
 B DYKIN
SET2
 SET TTKEY2 
 B DYKIN
SET3
 SET TTKEY3 
 B DYKIN
SET4
 SET TTKEY4 
 B DYKIN
CLR1
 CLEAR TTKEY1 
 B DYKIN
CLR2
 CLEAR TTKEY2 
 B DYKIN
CLR3
 CLEAR TTKEY3 
 B DYKIN
CLR4
 CLEAR TTKEY4 
 B DYKIN
* 
* 
DYK20 
* 
 PERF DKTEST
 BNOK SETCREAD
 TBF TTKEY1,DYKRET KEYBOARD OFF 
 IB SPKEY,DYK30,DYK40,DYK50 
DYK30 
 TBF TTKEY2,DYK80 KEYPOS 1
 B DYKRET 
DYK40 
 TBT TTKEY2,DYK80 KEYPOS 2
DYKRET
 PERF BELL
 B SETCREAD 
DYK50 
DYK80 
* 
			KEY SWITCHES 
 IB SPBINW2,UPD300,CLEA20 JUMP ON	C 
		UPDATE,CANC,CANC,		C
		UPDATE,UPDATE,UPDATE,UPDATE CONVERTED	C 
		UPDATE,UPDATE,UPDATE,UPDATE END-OF-ITEM-KEY	C 
		UPDATE,KDUPL,KEDIT
	 
* 
*    HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST 
* 
UPDATE
 CBE SPBINW1,='0',UPD350 JUMP IF LENGTH = 0 
 GETCTL 3,SPBINW4 GET SCHK-NUMBER 
 CBE SPBINW4,='0',UPD050 JUMP IF NOT STANDARD CHECK 
 PERFI SPBINW4,SPCHK1,SPCHK2,SPCHK3		C
		SPCHK4,SPCHK5,SPCHK6,SPCHK7 
 IB SPBINW3,UPD050,UPD070,ERRPRINT
* 
*    CONDITIONAL DISPLAYING 
* 
UPD050
 TBT SPDUPL,UPD100
 MOVE SPBINW4,='1' INDICATE COND. DISPL 
 B UPD200 
UPD070
 GETCTL 0,SPBINW3 GET APPL-VALUE
 CBNE SPBINW3,='0',UPD210 JUMP IF APPL VALUE
 B SETCREAD 
* 
*    UNCONDITIONAL DISPLAYING 
* 
UPD100
 MOVE SPBINW4,='2' INDICATE UNCONDITIONAL DISPLAY 
UPD200
 GETCTL 0,SPBINW3 GET APPL-VALUE
 CBE SPBINW3,='0',UPD400 JUMP IF NO APPL VALUE
* 
*    APPL-VALUE DIFFERENT FROM ZERO 
* 
UPD210
 PERF SPAPPL
 IB SPBINW3,UPD400,SETCREAD,ERRPRINT
 B UPD400 
* 
*    OK AFTER APPL CONTROL
*    UNCONDITIONAL DISPLAYING 
* 
UPD260
 UPDFLD 1,SPINPUT UPDATE FIELD WITH DISPLAYING
UPD300
	CBE	SPBINW1,='0',UPD350	SKIP NEXT IF LENGTH = 0
	SET	SPCHANGE	INDICATE CHANGED ITEM 
UPD350
*     TAKE CARE OF WARNING
 TBF SPWARNFL,UPD360
 MOVE SPBINW1,SPBINW2 STORE KEY VALUE 
 MOVE SPBINW4,=W'26' SET MESSAGE
 PERF SPERR 
 CBNE SPBINW2,CBIN2,UPD360 KOR-KEY ?
 MOVE SPBINW2,SPBINW1 RESET OLD KEYVALUE
UPD360
*    JUMP ON FUNCTION KEY INDEX 
 IB SPBINW2,READIN,DUMMY,		C
		KEOI,DUMMY,DUMMY,KTFWD,		C
		KTBWD,KTHOME,KTLDOWN,KTLEFT,KTRIGHT,		C 
		KTDOWN,KTUP,KCOPY,DUMMY,DUMMY,KENTER
 SUB SPBINW2,=W'14' ADJUST EOI-KEY INDEX
DUMMY 
RETUR 
 RET
* 
UPD400
 CBE SPBINW4,='2',UPD260 JUMP IF UNCONDITIONAL DISPL
 UPDFLD 0,SPINPUT UPDATE FIELD DISPL. COND. 
 B UPD300 
* 

KEOI			COMMON END-OF-ITEM KEY 
KTFWD			TAB. FORWARD 1 STEP 
	TFWD 
	B	TSTTAB 
* 
KTBWD			TABULATION 1 STEP BACKW.
 TBWD 
 B TSTTAB 
* 
KTHOME			TAB. TO HOME POSITION
 THOME
 B TSTTAB 
* 
KTLDOWN			TAB. TO FIRST ON NEXT LINE
 TLDOWN 
 B TSTTAB 
* 
KTLEFT			TAB. TO LEFTMOST 
 TLEFT
 B TSTTAB 
* 
KTRIGHT			TAB. TO RIGHTMOST 
 TRIGHT 
 B TSTTAB 
* 
KTDOWN			TAB 1 DOWN 
 TDOWN
 B TSTTAB 
* 
KTUP			TAB 1 UP 
 TUP

TSTTAB			TEST TAB OUTPUT
 BE READIN OK 
 BL READIN NOT FOUND
 BOFL SETCREAD EMPTY COMPULSORY FIELD 
* 
* 
*    CONDITIONAL TABULATION 
* 
 PERF SPTCHK
 CMP SPBINW3,='0' 
 BE SETCREAD
 IB SPBINW2,DUMMY,DUMMY,		C 
		KTFWD,DUMMY,DUMMY,KTFWD,		C 
		KTBWD,KTFWD,KTFWD,KTFWD,		C 
		KTBWD,KTFWD,KTBWD 
*    BRANCH LIST EXHAUSTED - SPBINW2 CLOBBERED BY SPTCHK

	B	SETCREAD 
	 
KCOPY			HARD COPY 
 MOVE SPBINW3,='1'
 PRINT KVOUCH,SPBINW3,='0'
 B SETCREAD SET CURSOR AND READ 
* 
KDUPL			DUPLICATION 
 MOVE SPBINW2,='3' INDICATE COMMON EOI-KEY
 DUPL SPINPUT DUPLICATION 
	BNZ	KDUPL2 
	COPY	GSWSTR1,CBIN0,CBIN1,SPINPUT,CBIN1	GET BYTE 1
	CBE	GSWSTR1,=X'00',KDUPL2
	MOVE	SPBINW1,='10'	SET LENGTH IN DUPFIELD
	SET SPDUPL 
 B UPDATE DUPL ALLOWED
KDUPL2
 MOVE SPBINW4,='4' INDICATE ILLEGAL EOI-KEY 
 B ERRPRINT DUPL NOT ALLOWED

* 
*    EDIT FIELD 
* 
KEDIT 
 GETCTL 1,SPBINW3 GET MAXL
 CBNE SPBINW3,='0',KED100 
 PERF BELL
 B SETCREAD 
KED100
 EDFLD SPINPUT,SPKTAB3,SPBINW1,		C
		SPBINW2,SPBINW4 
 B DYKOUT CONTINUE AS FOR DYKI
* 
*    ENTER KEY
* 
KENTER
 TBT SPCHANGE,KENT00	NO TESTS ON ME 
 TBF SPME,KENT05	FIELDS ? 
KENT00
 MOVE SPBINW4,='5' INDICATE COMP.FIELD FOUND
 MOVE SPBINW1,='0' INDICATE NO CLEARING 
 MOVE SPBINW2,='0' SET INDEX TO SEARCHED FIELD
 GETFLD 0,SPBINW2,SPBINW3 SEARCH FOR EMPTY COMP. FIELDS 
 BOFL KENT10 EMPTY COMP. FIELD FOUND
 TSTCTL 2 LOOK IF COMPULSORY FIELD
 BZ KENT05 NO!
 CALL EMPTYT,:FMTITEM LOOK IF EMPTY FIELD 
 BP KENT10 YES! 
KENT05
 MOVE SPBINW2,='3' INDICATE ENTER KEY DEPRESSED 
 RET
* 
*    EMPTY COMPULSORY FIELD FOUND 
* 
KENT10
 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD

ERRPRT
 PERF DKTEST
 BNOK SETCREAD
 CBE SPBINW2,='16',KEDIT	JUMP IF EDIT 
 CBE SPBINW2,='4',CANC JUMP IF CANCEL1
 CBE SPBINW2,='5',CANC JUMP IF CANCEL2
* 
*    ERROR HANDLING 
* 
ERRPRINT
* 
 MOVE SPBINW2,=X'40'
 XSTAT KEYB,SPBINW3 
 CBNE SPBINW2,SPBINW3,ERRPRT20
			TIMEOUT
 EDWRT SCREEN,ERAFMT ERASE SCREEN 
 B ERRC20 
ERRPRT20
	CBE	SPBINW4,='0',ERRC20
 PERF BELL
 MOVE SPBINW3,=X'1801' ROW 24 COL. 1
 DSC1 SCREEN,6,SPBINW3 SET CURSOR ON LAST ROW 
	MOVE	GSWBCD4,SPBINW4	ERRORCODE 
* 
 EDWRT SCREEN,SPFTBERR(SPBINW4) 
 TBF SPKEYFLG,SPERRRET
* 
*    READ AFTER ERROR 
* 
ERREAD
 SETCUR		SET CURSOR AT THE BEGINNING
			OF THE CURRENT FIELD 
ERR100
 MOVE SPBINW3,=W'14' REQUESTED LENGTH 
	IB	SPKEY,ERR105,ERR110,ERR115
ERR105
 NKI .NE,KEYB,SPINPUT,SPKTAB1,SPBINW3,SPBINW2 
	B	ERR120 
ERR110
	NKI	.NE,KEYB,SPINPUT,SPKTAB12,SPBINW3,SPBINW2
 B ERR120 
ERR115
 NKI .NE,KEYB,SPINPUT,SPKTAB13,SPBINW3,SPBINW2
ERR120
 BNZ ERR100 JUMP IF NOT OK
 PERF DKTEST
 BNOK SETCREAD
 CMP SPBINW2,='0' JUMP IF POWER OFF 
 BE RETUR 
 IB SPBINW2,ERR100,ERRCONT		C 
		ERRCONT,ERR100,ERRCONT,ERRCONT
 B ERR100 CONTINUE
* 
*    CLEAR ERROR PRINTOUT 
* 
ERRCONT 
	PERF	CLEAR8	ERASE LAST LINE
 CBNL SPBINW4,=W'26',CANC IF WARNING
 SUB SPBINW2,='1' ADJUST KEY INDEX
CANC
 CBE SPBINW1,='0',ERRC10 JUMP IF LENGTH = 0 
 MOVE SPINPUT,:FMTITEM SAVE CURRENT CONTENTS
 MOVE :FMTITEM,=C'1' PUT SOMETHING IN THE FIELD 
 GETABX SPBINW4 GET CURRENT INDEX 
 ERASE 10,SPBINW4,SPBINW4 CLEAR FIELD 
ERRC10
 IB SPBINW2,CLEAR1,CLEAR2,DUMMY 
 SUB SPBINW2,='3' ADJUST FOR CANCEL1,CANCEL2
 RET
CLEAR1
 CBE SPBINW1,='0',ERRC20 JUMP IF LENGTH = 0 
 SET SPCHANGE INDICATE CHANGED FIELD
ERRC20
	MOVE	SPBINW5,$OPT	CHECHK IF SPERR
	CBE	SPBINW5,=W'0',SPERRRET 
 B SETCREAD CONTINUE
* 
CLEAR2
 MOVE :FMTITEM,SPINPUT RESTORE CURRENT CONTENTS 
CLEA20
 GETABX SPBINW4 GET CURRENT TAB INDEX 
 DISPLAY 1,SPBINW4,SPBINW4 DISPLAY FIELD
	MOVE	SPBINW5,$OPT	CHECK IF SPERR 
	CBE	SPBINW5,=W'0',SPERRRET 
 B SETCREAD CONTINUE
* 
SPERRRET
	RET
 PEND 
* 
BELL PROC 
*          ACUSTIC ALARM
 EDWRT SCREEN,BELLFMT 
 RET
* 
BELLFMT FRMT
 FSL
 FILLR X'07',1
 FMEND

	PEND 
* 
ERAFMT FRMT 
 FILLR '1',2
 FMEND
* 
	 
SPLIN8 PROC WRTMES,WRTTYP 
********************
* 
*          SPLIN8 - WRITE ON LINE 8 
* 
*          MESSAGE DEFINED AS FORMAT NUMBER WRTMES
*          IN FORMAT TABLE SPFTBMES 
* 
*          WRTTYP:   =0  NO WAIT
*                    =1  WAIT 
*                    =2  RETURN 
* 
******************* 
	MOVE SPBINW1,=X'1801'
	DSC1	SCREEN,6,SPBINW1	SET CURSOR ON LAST ROW 
 MOVE SPBINW1,CBIN0 
 CBE WRTMES,CBIN0,LIN800
 CBL WRTTYP,CBIN3,LIN801
 EDWRT .NW,SCREEN,SPFTBMES(WRTMES)
 B LINRET 
LIN801
	EDWRT	SCREEN,SPFTBMES(WRTMES)
LIN800
	CBE	WRTTYP,=W'0',LIN8NW
 CBE WRTTYP,=W'2',LINRET
* READ
LIN8IN
	MOVE	SPBINW1,=W'3'	REQUESTED LENGTH
	IB	SPKEY,LIN805,LIN810,LIN815
LIN805
	NKI	KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 
	B	LIN820 
LIN810
	NKI	KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2
 B LIN820 
LIN815
 NKI KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2
LIN820
	BNOK	LIN8IN	JUMP IF NOT OK 
 PERF DKTEST
 CBE SPBINW2,CBIN2,LIN8CT 
 B LIN8IN 
* CLEAR LINE
LIN8CT
	PERF	CLEAR8	ERASE LAST LINE
	RET
* READ WITH NO WAIT 
LIN8NW
	MOVE	SPBINW1,=W'3'	REQUESTED LENGTH
	IB	SPKEY,LIN855,LIN860,LIN865
LIN855
	NKI	.NW,KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 
	B	LIN870 
LIN860
	NKI	.NW,KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2
 B LIN870 
LIN865
 NKI .NW,KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2
LIN870
 PERF DKTEST
LINRET
	RET
	PEND 


KBTEST PROC 
 PERF SPLIN8,CBIN0,CBIN0
 TESTIO KEYB
 BOK KBT10
 CALL ABORT,KEYB
 B KBT20
KBT10 
 WAIT KEYB
 CBNE SPBINW2,CBIN6,KBT20 
 CMP CBIN0,CBIN0
 RET
KBT20 
 CMP CBIN0,CBIN1
 RET
 PEND 
	 
SPINF1	PROC 
********************
* 
*          SPINF1 - WRITE INF ON FIRST LINE 
* 
********************
	MOVE	SPBINW1,=X'0117'
	DSC1	SCREEN,6,SPBINW1	SET CURSOR ON FIRST LINE 
	MOVE	SPBINW1,CBIN0 
	EDWRT	SCREEN,SPFTBMES(CBIN7)	WRITE MESSAGE 7 
	RET
	PEND 
* 
* 
* 
DKTEST PROC 
* TEST IF THE DISK IS SWITCHED OFF, 
 TBF CDKOFF,DKTRET
 TBT GTMASTFL,DKTRET
 TBF CDUOVL,DKTRET NO KI IF DISKOVL ON DU 
 MOVE SPBINW5,=X'1801'
 DSC1 SCREEN,6,SPBINW5
 EDWRT .NW,SCREEN,SPFTBMES(CBIN14)
DKT10 
 DELAY CBIN10 
 TBT CDKOFF,DKT10 
 PERF CLEAR8
 CMP CBIN1,CBIN0 NOK
 RET
DKTRET
 CMP CBIN0,CBIN0
 RET
 PEND 

 END
DataMuseum.dk

Philips Data Systems

⟦a514d65f5⟧

Derivation

PTS(SC)

Full view
