KLASMAN ;GLRISC/PDW CLASSMAN ROUTINE ;DEC 18,1990@13:54:58 [ 12/13/94 8:01 AM ]
;;1.0
EN D DT^DICRW
S OPEX="Q",X=0 X ^%ZOSF("RM") S TYP=^%ZOSF("TYPE-AHEAD")
X ^%ZOSF("NBRK")
S X="CLASS" S IOP=$O(^%ZIS(1,"B",X)) I $E(IOP,1,5)'=X W !,"NO LOOPBACKS WITH 'CLASS' " K X,IOP
OPEN D ^%ZIS I POP K POP,IOP W !,"SORRY ! ... no Loopbacks available.",! S IOP="HOME" D ^%ZIS Q
S X=0 U IO X ^%ZOSF("RM") U IO(0) S X=0 X ^%ZOSF("RM")
I ^%ZOSF("OS")["MSM-UNIX" U IO:(::::+2097152+4096+512+1:+8388608+262144+64) ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
EN1 ;
DISP I $D(^KLAS(1200,"B")) U IO(0) W !,"Existing Classes are: ",! S DIC="^KLAS(1200,",DIC(0)="AEQMZ",D="B",DZ="??" D DQ^DICQ
;
;U 0:(0::::#000001:#800040:::$C(8,13,15,18,21,24,27,127)) W !
I ^%ZOSF("OS")["MSM-UNIX" U IO:(::::+2097152+4096+512+1:+8388608+262144+64) ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
U IO(0) W !,"You are using loopback : ",ION,?$X+5,IO,!
S KNAM=ION,KPORT=IO,COM=0,ZB=^%ZOSF("TRMRD"),TERMNORM="S X=IOM X ^%ZOSF(""RM""),^(""EON""),^(""TRMOFF""),^(""TYPE-AHEAD"")",TERMKLAS="S X=0 X ^%ZOSF(""RM""),^(""EOFF""),^(""TRMON""),^(""TYPE-AHEAD"")"
U IO(0) X TERMNORM
S Z0=1,BCS=0,BT=$P($H,",",2),SCREEN=0,X2=0,T1=1,P1=0,P2=0,(SCOUNT,WCOUNT)=0,LIMIT=1000,TL=$P($H,",",2),CTRL=5,STUDIR=0
S SLINE="",CR=$C(13),SCREEN=0,SLCOUNT=0,GLOB="" ; VARIABLES FOR SCREEN SAVE
K DIE,DIC S X="NEW",DIC="^KLAS(1200,",DIC(0)="MLZ",DIC("DR")=".5;1;6///"_KNAM D FILE^DICN K DIC G:Y'>0 EXIT3^KLASMAN0 S JOB=+Y,^KLAS(1200,JOB,"M",0)="^1200.03A^^",^KLAS(1200,JOB,"P1")=""
A S DIC="^KLAS(1200.4,",DIC(0)="QMLZ",X=$P(Y(0),"^",2),DIC("DR")="1///"_Y(0,0)_";1.5//NO;2///NOW;3///NOW" D FILE^DICN S CLNUM=+Y
S ^KLAS(1200.4,CLNUM,1,0)="^1200.44^^"
K DIC S DIE="^KLAS(1200,",DA=JOB,DR="2////"_CLNUM D ^DIE K DIE
U IO(0) W !,"The current Command Character is CTRL-",$C(CTRL+64),!
REVIEW D DOC^KLASMAN3 S Z="WELCOME TO THE CLASS" D BCS
CON ; CONTINUE RE-ENTRY POINT
S Z="",NULL="",KXON=0 U IO S X=0 X ^%ZOSF("RM"),^("EOFF"),^("TYPE-AHEAD"),^("TRMOFF")
U IO(0) X TERMKLAS
U IO:(0::::#001001:#800040:::$C(3,8,13,21,24,27,127))
;U IO:(0::::#801001),0:(0::::#8000001)
;I ^%ZOSF("OS")["MSM-UNIX" U IO:(::::+2097152+4096+512+1:+8388608+262144+64) ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
S CC=$C(CTRL),TK=0,TP=0,TMC="X ^%ZOSF(""TRMRD"")",(TCK,TCP,JMP)="",TT=0 S:'$D(STUDIR) STUDIR=0 S TN=$P($H,",",2),(TL,TL1,TSL)=TN
INPUT S WCOUNT=0,JMP="",L3=0
F K=0:0 D KEYB Q:JMP'=""
I JMP="CTRL" U IO(0) W:$D(KLASPG) @IOF D CTRL^KLASMAN0 U IO(0) H:$D(KLASPG) 1 W:$D(KLASPG) @IOF U IO G:(JMP'="EXIT") CON
U IO(0) X TERMKLAS I JMP="EXIT" X TERMNORM K JMP G EXIT^KLASMAN0
G INPUT
;
KEYB ;
S TN=$P($H,",",2) I COM D KEY G OUT
U IO(0) R Z:TK S Z=TCK_Z,TCK="",TK=0 I X TMC S TCK=$C(Y) S:Y=CTRL Y=0,JMP="CTRL",TCK="" S:Y=27 TK=1 I Y=13 U IO W Z,*Y S Z="",TCK="",TL=TN
I $L(Z),Z'="" S TP=0,TL=TN U IO W Z
OUT ;
U IO W:KXON *17 R Z#200:TP S:$T TT=1 X TMC W:KXON *19 S Z=TCP_Z,TCP="" I TT S TCP=$C(Y),TP=1,TT=0
I $L(Z) U IO(0) S TL=TN W Z D:Z0 BCS
TIMER S TN=$P($H,",",2) I TP,(TN-TL>90),Z="" S Z=" "_$C(8),(TL,TL1)=TN U IO(0) W Z D:Z0 BCS U IO W " " R Z#1:3 W:Z=" " *127 D:Z=" " BCS U IO(0) W Z U IO
I TP=0 S:(TN-TL>8) TP=1
MSG I $D(^KLAS(1200,JOB,"AMSG")) S MSGDA=$O(^("AMSG","")),MSG=$O(^(MSGDA,"")) U IO(0) W:MSG'="" *7,!,?30,"*** ",MSG," ***",! S:MSG="BDIRECT" STUDIR=1 S:MSG="EDIRECT" STUDIR=0 H 1 K ^(MSG),MSG,MSGDA
Q
BCS ;
Q:Z="" S SCOUNT=SCOUNT+1,^KLAS(1200,JOB,"S",SCOUNT,0)=Z,^KLAS(1200,JOB,"P1")=SCOUNT S:SCOUNT>(LIMIT-1) SCOUNT=0 D:SCREEN SLINE
Q
KEY ;CODE TO SCAN STUDENT INPUT FOR APPLICATION AND INSTRUCTOR FOR INTERUPT
S RCOUNT=^KLAS(1200,JOB,"R1") U IO(0) R Z:0 I W !,"TAKING COMMAND",! D COMOLD^KLASMAN0 S STUDIR=0 Q
I (WCOUNT=LIMIT)&(RCOUNT'=LIMIT) S WCOUNT=0
I WCOUNT'=RCOUNT S TP=0,TL=TN F WCOUNT=WCOUNT+1:1:$S(RCOUNT>WCOUNT:RCOUNT,1:LIMIT) D:'$D(^KLAS(1200,JOB,"R",WCOUNT,0)) LOOPD S Z=^KLAS(1200,JOB,"R",WCOUNT,0) G:STUDIR STUDIR U IO W:Z'=$C(13) Z W:Z=$C(13) "",*13
S Z=""
Q
LOOPD ;
G:'$D(^KLAS(1200,JOB,"R",WCOUNT,0)) LOOPD
Q
STUDIR D BCS U IO(0) W Z I TN-TL1>90 U IO W " " H 1 W *127 S TL1=TN
Q
SLINE ; SAVE SCREENS TO GLOB
Q:Z="" I Z[CR D SLSET S SLINE=Z,Z="" Q
S LEN=$L(Z)+$L(SLINE) I LEN>230 D SLSET S SLINE=Z,Z="" Q
S SLINE=SLINE_Z,Z="" D:(TN-TSL>15) SLSET Q
SLSET ;
F CHAR=10,12,13 F I=0:0 S X=$F(SLINE,$C(CHAR)) Q:'X S SLINE=$E(SLINE,0,X-2)_$E(SLINE,X,999)
S SLCOUNT=SLCOUNT+1,@(GLOB_SLCOUNT_",0)")=SLINE,SLINE="",TSL=TN
Q
EX1 W !,"SORRY NO PORTS AVAILABLE",! K KNAM,X,IOP L Q
;-----------------------------------------------------------
CLEAN D CLEAN^KLASMAN1 Q
XRAY D XRAY^KLASDIA Q
XX D XX^KLASDIA Q
STUFF D STUFF^KLASDIA Q
PICK D PICKUP^KLASMAN0 S KLW=SCOUNT Q
SXRAY D SXRAY^KLASDIA Q
SXX D SXX^KLASDIA Q
KLASMAN ;GLRISC/PDW CLASSMAN ROUTINE ;DEC 18,1990@13:54:58 [ 12/13/94 8:01 AM ]
+1 ;;1.0
EN DO DT^DICRW
+1 SET OPEX="Q"
SET X=0
XECUTE ^%ZOSF("RM")
SET TYP=^%ZOSF("TYPE-AHEAD")
+2 XECUTE ^%ZOSF("NBRK")
+3 SET X="CLASS"
SET IOP=$ORDER(^%ZIS(1,"B",X))
IF $EXTRACT(IOP,1,5)'=X
WRITE !,"NO LOOPBACKS WITH 'CLASS' "
KILL X,IOP
OPEN DO ^%ZIS
IF POP
KILL POP,IOP
WRITE !,"SORRY ! ... no Loopbacks available.",!
SET IOP="HOME"
DO ^%ZIS
QUIT
+1 SET X=0
USE IO
XECUTE ^%ZOSF("RM")
USE IO(0)
SET X=0
XECUTE ^%ZOSF("RM")
+2 ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
IF ^%ZOSF("OS")["MSM-UNIX"
USE IO:(::::+2097152+4096+512+1:+8388608+262144+64)
EN1 ;
DISP IF $DATA(^KLAS(1200,"B"))
USE IO(0)
WRITE !,"Existing Classes are: ",!
SET DIC="^KLAS(1200,"
SET DIC(0)="AEQMZ"
SET D="B"
SET DZ="??"
DO DQ^DICQ
+1 ;
+2 ;U 0:(0::::#000001:#800040:::$C(8,13,15,18,21,24,27,127)) W !
+3 ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
IF ^%ZOSF("OS")["MSM-UNIX"
USE IO:(::::+2097152+4096+512+1:+8388608+262144+64)
+4 USE IO(0)
WRITE !,"You are using loopback : ",ION,?$X+5,IO,!
+5 SET KNAM=ION
SET KPORT=IO
SET COM=0
SET ZB=^%ZOSF("TRMRD")
SET TERMNORM="S X=IOM X ^%ZOSF(""RM""),^(""EON""),^(""TRMOFF""),^(""TYPE-AHEAD"")"
SET TERMKLAS="S X=0 X ^%ZOSF(""RM""),^(""EOFF""),^(""TRMON""),^(""TYPE-AHEAD"")"
+6 USE IO(0)
XECUTE TERMNORM
+7 SET Z0=1
SET BCS=0
SET BT=$PIECE($HOROLOG,",",2)
SET SCREEN=0
SET X2=0
SET T1=1
SET P1=0
SET P2=0
SET (SCOUNT,WCOUNT)=0
SET LIMIT=1000
SET TL=$PIECE($HOROLOG,",",2)
SET CTRL=5
SET STUDIR=0
+8 ; VARIABLES FOR SCREEN SAVE
SET SLINE=""
SET CR=$CHAR(13)
SET SCREEN=0
SET SLCOUNT=0
SET GLOB=""
+9 KILL DIE,DIC
SET X="NEW"
SET DIC="^KLAS(1200,"
SET DIC(0)="MLZ"
SET DIC("DR")=".5;1;6///"_KNAM
DO FILE^DICN
KILL DIC
IF Y'>0
GOTO EXIT3^KLASMAN0
SET JOB=+Y
SET ^KLAS(1200,JOB,"M",0)="^1200.03A^^"
SET ^KLAS(1200,JOB,"P1")=""
A SET DIC="^KLAS(1200.4,"
SET DIC(0)="QMLZ"
SET X=$PIECE(Y(0),"^",2)
SET DIC("DR")="1///"_Y(0,0)_";1.5//NO;2///NOW;3///NOW"
DO FILE^DICN
SET CLNUM=+Y
+1 SET ^KLAS(1200.4,CLNUM,1,0)="^1200.44^^"
+2 KILL DIC
SET DIE="^KLAS(1200,"
SET DA=JOB
SET DR="2////"_CLNUM
DO ^DIE
KILL DIE
+3 USE IO(0)
WRITE !,"The current Command Character is CTRL-",$CHAR(CTRL+64),!
REVIEW DO DOC^KLASMAN3
SET Z="WELCOME TO THE CLASS"
DO BCS
CON ; CONTINUE RE-ENTRY POINT
+1 SET Z=""
SET NULL=""
SET KXON=0
USE IO
SET X=0
XECUTE ^%ZOSF("RM")
XECUTE ^("EOFF")
XECUTE ^("TYPE-AHEAD")
XECUTE ^("TRMOFF")
+2 USE IO(0)
XECUTE TERMKLAS
+3 USE IO:(0::::#001001:#800040:::$CHAR(3,8,13,21,24,27,127))
+4 ;U IO:(0::::#801001),0:(0::::#8000001)
+5 ;I ^%ZOSF("OS")["MSM-UNIX" U IO:(::::+2097152+4096+512+1:+8388608+262144+64) ;set passall;ctrl/O as data;assert DTR;no echo;;input buffer XON;7b data
+6 SET CC=$CHAR(CTRL)
SET TK=0
SET TP=0
SET TMC="X ^%ZOSF(""TRMRD"")"
SET (TCK,TCP,JMP)=""
SET TT=0
IF '$DATA(STUDIR)
SET STUDIR=0
SET TN=$PIECE($HOROLOG,",",2)
SET (TL,TL1,TSL)=TN
INPUT SET WCOUNT=0
SET JMP=""
SET L3=0
+1 FOR K=0:0
DO KEYB
IF JMP'=""
QUIT
+2 IF JMP="CTRL"
USE IO(0)
IF $DATA(KLASPG)
WRITE @IOF
DO CTRL^KLASMAN0
USE IO(0)
IF $DATA(KLASPG)
HANG 1
IF $DATA(KLASPG)
WRITE @IOF
USE IO
IF (JMP'="EXIT")
GOTO CON
+3 USE IO(0)
XECUTE TERMKLAS
IF JMP="EXIT"
XECUTE TERMNORM
KILL JMP
GOTO EXIT^KLASMAN0
+4 GOTO INPUT
+5 ;
KEYB ;
+1 SET TN=$PIECE($HOROLOG,",",2)
IF COM
DO KEY
GOTO OUT
+2 USE IO(0)
READ Z:TK
SET Z=TCK_Z
SET TCK=""
SET TK=0
IF $TEST
XECUTE TMC
SET TCK=$CHAR(Y)
IF Y=CTRL
SET Y=0
SET JMP="CTRL"
SET TCK=""
IF Y=27
SET TK=1
IF Y=13
USE IO
WRITE Z,*Y
SET Z=""
SET TCK=""
SET TL=TN
+3 IF $LENGTH(Z)
IF Z'=""
SET TP=0
SET TL=TN
USE IO
WRITE Z
OUT ;
+1 USE IO
IF KXON
WRITE *17
READ Z#200:TP
IF $TEST
SET TT=1
XECUTE TMC
IF KXON
WRITE *19
SET Z=TCP_Z
SET TCP=""
IF TT
SET TCP=$CHAR(Y)
SET TP=1
SET TT=0
+2 IF $LENGTH(Z)
USE IO(0)
SET TL=TN
WRITE Z
IF Z0
DO BCS
TIMER SET TN=$PIECE($HOROLOG,",",2)
IF TP
IF (TN-TL>90)
IF Z=""
SET Z=" "_$CHAR(8)
SET (TL,TL1)=TN
USE IO(0)
WRITE Z
IF Z0
DO BCS
USE IO
WRITE " "
READ Z#1:3
IF Z=" "
WRITE *127
IF Z=" "
DO BCS
USE IO(0)
WRITE Z
USE IO
+1 IF TP=0
IF (TN-TL>8)
SET TP=1
MSG IF $DATA(^KLAS(1200,JOB,"AMSG"))
SET MSGDA=$ORDER(^("AMSG",""))
SET MSG=$ORDER(^(MSGDA,""))
USE IO(0)
IF MSG'=""
WRITE *7,!,?30,"*** ",MSG," ***",!
IF MSG="BDIRECT"
SET STUDIR=1
IF MSG="EDIRECT"
SET STUDIR=0
HANG 1
KILL ^(MSG),MSG,MSGDA
+1 QUIT
BCS ;
+1 IF Z=""
QUIT
SET SCOUNT=SCOUNT+1
SET ^KLAS(1200,JOB,"S",SCOUNT,0)=Z
SET ^KLAS(1200,JOB,"P1")=SCOUNT
IF SCOUNT>(LIMIT-1)
SET SCOUNT=0
IF SCREEN
DO SLINE
+2 QUIT
KEY ;CODE TO SCAN STUDENT INPUT FOR APPLICATION AND INSTRUCTOR FOR INTERUPT
+1 SET RCOUNT=^KLAS(1200,JOB,"R1")
USE IO(0)
READ Z:0
IF $TEST
WRITE !,"TAKING COMMAND",!
DO COMOLD^KLASMAN0
SET STUDIR=0
QUIT
+2 IF (WCOUNT=LIMIT)&(RCOUNT'=LIMIT)
SET WCOUNT=0
+3 IF WCOUNT'=RCOUNT
SET TP=0
SET TL=TN
FOR WCOUNT=WCOUNT+1:1:$SELECT(RCOUNT>WCOUNT:RCOUNT,1:LIMIT)
IF '$DATA(^KLAS(1200,JOB,"R",WCOUNT,0))
DO LOOPD
SET Z=^KLAS(1200,JOB,"R",WCOUNT,0)
IF STUDIR
GOTO STUDIR
USE IO
IF Z'=$CHAR(13)
WRITE Z
IF Z=$CHAR(13)
WRITE "",*13
+4 SET Z=""
+5 QUIT
LOOPD ;
+1 IF '$DATA(^KLAS(1200,JOB,"R",WCOUNT,0))
GOTO LOOPD
+2 QUIT
STUDIR DO BCS
USE IO(0)
WRITE Z
IF TN-TL1>90
USE IO
WRITE " "
HANG 1
WRITE *127
SET TL1=TN
+1 QUIT
SLINE ; SAVE SCREENS TO GLOB
+1 IF Z=""
QUIT
IF Z[CR
DO SLSET
SET SLINE=Z
SET Z=""
QUIT
+2 SET LEN=$LENGTH(Z)+$LENGTH(SLINE)
IF LEN>230
DO SLSET
SET SLINE=Z
SET Z=""
QUIT
+3 SET SLINE=SLINE_Z
SET Z=""
IF (TN-TSL>15)
DO SLSET
QUIT
SLSET ;
+1 FOR CHAR=10,12,13
FOR I=0:0
SET X=$FIND(SLINE,$CHAR(CHAR))
IF 'X
QUIT
SET SLINE=$EXTRACT(SLINE,0,X-2)_$EXTRACT(SLINE,X,999)
+2 SET SLCOUNT=SLCOUNT+1
SET @(GLOB_SLCOUNT_",0)")=SLINE
SET SLINE=""
SET TSL=TN
+3 QUIT
EX1 WRITE !,"SORRY NO PORTS AVAILABLE",!
KILL KNAM,X,IOP
LOCK
QUIT
+1 ;-----------------------------------------------------------
CLEAN DO CLEAN^KLASMAN1
QUIT
XRAY DO XRAY^KLASDIA
QUIT
XX DO XX^KLASDIA
QUIT
STUFF DO STUFF^KLASDIA
QUIT
PICK DO PICKUP^KLASMAN0
SET KLW=SCOUNT
QUIT
SXRAY DO SXRAY^KLASDIA
QUIT
SXX DO SXX^KLASDIA
QUIT
