- KLASMAN1 ;BIR/PDW KLASMAN CONTINUED;DEC 18,1990@13:54:58
- ;;1.0
- DIRECT ; DIRECT KEYBOARD INPUT TO GLOBAL (FOR TAPE)
- S TN=$P($H,",",2),TL=TN,TL1=TN,M=LIMIT,C=SCOUNT,ZE="",X=240 X ^%ZOSF("RM") U IO(0) W !,"Entering Direct Mode",!
- W !,"Enter CTRL-",$C(CTRL+64)," Twice to End Direct Mode",!
- X ^%ZOSF("EON"),^%ZOSF("TRMON")
- RD W ZE,*17 R X#200:2 X TMC W *19 S X=ZE_X,ZE="" I $T D:$L(X) BCS S X="" G:Y=CTRL QRD S ZE=$C(Y)
- S TN=$P($H,";",2) D BCS I TN-TL>90 U IO W " ",*127 S TL=TN
- I TN-TL1>90 S X=" "_$C(8),TL1=TN D BCS
- G RD
- BCS Q:'$L(X) S:C=M C=0 S TL1=TN,C=C+1,^KLAS(1200,JOB,"S",C,0)=X,^KLAS(1200,JOB,"P1")=C,KLW=C Q
- QRD W *17,*7 R X#1:8 X TMC W *19 I '$T S ZE=$C(CTRL)_X G RD
- I Y'=CTRL S ZE=$C(CTRL)_$C(Y) G RD
- QRD1 S SCOUNT=C X ^%ZOSF("EOFF") U IO(0) W *17,!,"Ending Direct Mode",!,"----->>ON LINE MODE<<",! X ^%ZOSF("EOFF")
- Q
- ;----------------------------------
- CON G CON^KLASMAN
- CLEAN ;
- K ^KLAS(1200,"B") S DIK="^KLAS(1200," D IXALL^DIK K DIK W !,"SELECT CLASS TO BE CLEARED",! S DIC="^KLAS(1200,",DIC(0)="EQZ",X="?" D ^DIC S DIC(0)="AEQZ" D ^DIC I +Y'>0 W !,"NONE SELECTED",! Q
- S KNUM=$P(Y(0),"^",4),CLNUM=$P(Y(0),"^",3),JOB=+Y D CLEAN^KLASMAN0
- Q
- XRAY D XRAY^KLASDIA Q
- XX D XX^KLASDIA Q
- PICK D PICKUP^KLASMAN0 S KLW=SCOUNT Q
- KLASMAN1 ;BIR/PDW KLASMAN CONTINUED;DEC 18,1990@13:54:58
- +1 ;;1.0
- DIRECT ; DIRECT KEYBOARD INPUT TO GLOBAL (FOR TAPE)
- +1 SET TN=$PIECE($HOROLOG,",",2)
- SET TL=TN
- SET TL1=TN
- SET M=LIMIT
- SET C=SCOUNT
- SET ZE=""
- SET X=240
- XECUTE ^%ZOSF("RM")
- USE IO(0)
- WRITE !,"Entering Direct Mode",!
- +2 WRITE !,"Enter CTRL-",$CHAR(CTRL+64)," Twice to End Direct Mode",!
- +3 XECUTE ^%ZOSF("EON")
- XECUTE ^%ZOSF("TRMON")
- RD WRITE ZE,*17
- READ X#200:2
- XECUTE TMC
- WRITE *19
- SET X=ZE_X
- SET ZE=""
- IF $TEST
- IF $LENGTH(X)
- DO BCS
- SET X=""
- IF Y=CTRL
- GOTO QRD
- SET ZE=$CHAR(Y)
- +1 SET TN=$PIECE($HOROLOG,";",2)
- DO BCS
- IF TN-TL>90
- USE IO
- WRITE " ",*127
- SET TL=TN
- +2 IF TN-TL1>90
- SET X=" "_$CHAR(8)
- SET TL1=TN
- DO BCS
- +3 GOTO RD
- BCS IF '$LENGTH(X)
- QUIT
- IF C=M
- SET C=0
- SET TL1=TN
- SET C=C+1
- SET ^KLAS(1200,JOB,"S",C,0)=X
- SET ^KLAS(1200,JOB,"P1")=C
- SET KLW=C
- QUIT
- QRD WRITE *17,*7
- READ X#1:8
- XECUTE TMC
- WRITE *19
- IF '$TEST
- SET ZE=$CHAR(CTRL)_X
- GOTO RD
- +1 IF Y'=CTRL
- SET ZE=$CHAR(CTRL)_$CHAR(Y)
- GOTO RD
- QRD1 SET SCOUNT=C
- XECUTE ^%ZOSF("EOFF")
- USE IO(0)
- WRITE *17,!,"Ending Direct Mode",!,"----->>ON LINE MODE<<",!
- XECUTE ^%ZOSF("EOFF")
- +1 QUIT
- +2 ;----------------------------------
- CON GOTO CON^KLASMAN
- CLEAN ;
- +1 KILL ^KLAS(1200,"B")
- SET DIK="^KLAS(1200,"
- DO IXALL^DIK
- KILL DIK
- WRITE !,"SELECT CLASS TO BE CLEARED",!
- SET DIC="^KLAS(1200,"
- SET DIC(0)="EQZ"
- SET X="?"
- DO ^DIC
- SET DIC(0)="AEQZ"
- DO ^DIC
- IF +Y'>0
- WRITE !,"NONE SELECTED",!
- QUIT
- +2 SET KNUM=$PIECE(Y(0),"^",4)
- SET CLNUM=$PIECE(Y(0),"^",3)
- SET JOB=+Y
- DO CLEAN^KLASMAN0
- +3 QUIT
- XRAY DO XRAY^KLASDIA
- QUIT
- XX DO XX^KLASDIA
- QUIT
- PICK DO PICKUP^KLASMAN0
- SET KLW=SCOUNT
- QUIT
