KLASMAN1.m

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