KLASMAN2 ; GLRISC/PDW SCREEN OPEN AND SAVE FOR CLASSMAN ;DEC 18,1990@13:54:58
;;1.0
1 D:'$D(DT) DT^DICRW
I '$D(SCREEN) S SCREEN=0
G:$D(NAMDIC) FRAME
START ; select ZZCLASS name
D:SCREEN CLOSE
S DIC="^KLAS(1200.1,",DIC(0)="AEQLZN" D ^DIC W !
S NAMDIC=DIC
I X="^"!(Y<0) K DIC,NAMDIC W !,"NO SELECTION ... YOU ARE RETURNED TO YOUR APPLICATION",!,">>ON-LINE MODE<-------",! Q
S DA(1)=+Y
FRAME ; --- select slide ----
D:SCREEN CLOSE
S DIC=NAMDIC_DA(1)_",1,",DIC(0)="AEQLZN"
S NODE=DIC_"0)" S $P(@NODE,"^",2)="1200.11I" K NODE
S DIC("A")="Select SLIDE: "
D ^DIC
K DIC("A")
G:X="^" START G:Y<0 START
OPEN ; --- open slide ---
S FRNAME=$P(Y,U,2),DIE=DIC,DA=+Y,DR="10///S" D ^DIE S DIC=DIE,Y=DA K DIE
S SLDIC=DIC,GLOB=DIC_+Y_",""W"","
S NODE=GLOB_"0)" S:'$D(@NODE) @NODE=""
S SLCOUNT=$P(@(GLOB_"0)"),U,3),SCREEN=1,Z0=1,BCS=1
S:SLCOUNT="" SLCOUNT=0
W !,FRNAME," IS OPEN AT LINE ",SLCOUNT,!,"USE |CTRL-A| | 1 | AND |CTRL-A| | 0 | TO CONTROL SCREEN SAVING, SAVING IS ON",!,"------->>ON-LINE MODE<<",!
Q
CLOSE ; --- CLOSE SLIDE
S @(GLOB_"0)")=U_U_SLCOUNT_U_SLCOUNT_U_DT
S $P(@(SLDIC_"0)"),U,2)="N"
S SCREEN=0
W !,FRNAME," IS CLOSED AT LINE ",SLCOUNT
Q
STUFF ; STUFF ONE SLIDE INTO ANOTHER
W !!,"SOURCE ?",! D S1 G:Y'>0 SEXIT S G1=GLOB W !!,"TARGET ?",! D S1 G:Y'>0 SEXIT S G2=GLOB
S %X=G1,%Y=G2 D %XY^%RCR
SEXIT K G1,G2,NODE,FRNAME,GLOB,NAMEDIC Q
S1 S DIC="^KLAS(1200.1,",DIC(0)="AEQLZN" D ^DIC W !
S NAMDIC=DIC
I X="^"!(Y<0) K DIC,NAMDIC W !,"NO SELECTION ... YOU ARE RETURNED TO YOUR APPLICATION",! Q
S DA(1)=+Y
FRAME1 ; --- select slide ----
S DIC=NAMDIC_DA(1)_",1,",DIC(0)="AEQLZN"
S NODE=DIC_"0)" S $P(@NODE,"^",2)="1200.11I" K NODE
S DIC("A")="Select SLIDE: "
D ^DIC
K DIC("A")
G:X="^" STUFF G:Y<0 STUFF
OPEN1 ; --- open slide ---
S FRNAME=$P(Y,U,2),DIE=DIC,DA=+Y,DR="10///S" D ^DIE S DIC=DIE,Y=DA K DIE
S GLOB=DIC_+Y_",""W""," Q
XRAY ;
D QUES F I=START:1:END S X=^KLAS("TEST",I) W !,I,?5,$L(X),! F J=1:1:$L(X) S Z=$E(X,J) W $S($A(Z)>32:Z,1:"."_$A(Z)_".") ;
Q
XX ;
D QUES F I=START:1:END W ^KLAS("TEST",I) ;
Q
QUES R !,"START ? ",START:30 R " END ? ",END:30 W ! Q
PRT Q
KLASMAN2 ; GLRISC/PDW SCREEN OPEN AND SAVE FOR CLASSMAN ;DEC 18,1990@13:54:58
+1 ;;1.0
1 IF '$DATA(DT)
DO DT^DICRW
+1 IF '$DATA(SCREEN)
SET SCREEN=0
+2 IF $DATA(NAMDIC)
GOTO FRAME
START ; select ZZCLASS name
+1 IF SCREEN
DO CLOSE
+2 SET DIC="^KLAS(1200.1,"
SET DIC(0)="AEQLZN"
DO ^DIC
WRITE !
+3 SET NAMDIC=DIC
+4 IF X="^"!(Y<0)
KILL DIC,NAMDIC
WRITE !,"NO SELECTION ... YOU ARE RETURNED TO YOUR APPLICATION",!,">>ON-LINE MODE<-------",!
QUIT
+5 SET DA(1)=+Y
FRAME ; --- select slide ----
+1 IF SCREEN
DO CLOSE
+2 SET DIC=NAMDIC_DA(1)_",1,"
SET DIC(0)="AEQLZN"
+3 SET NODE=DIC_"0)"
SET $PIECE(@NODE,"^",2)="1200.11I"
KILL NODE
+4 SET DIC("A")="Select SLIDE: "
+5 DO ^DIC
+6 KILL DIC("A")
+7 IF X="^"
GOTO START
IF Y<0
GOTO START
OPEN ; --- open slide ---
+1 SET FRNAME=$PIECE(Y,U,2)
SET DIE=DIC
SET DA=+Y
SET DR="10///S"
DO ^DIE
SET DIC=DIE
SET Y=DA
KILL DIE
+2 SET SLDIC=DIC
SET GLOB=DIC_+Y_",""W"","
+3 SET NODE=GLOB_"0)"
IF '$DATA(@NODE)
SET @NODE=""
+4 SET SLCOUNT=$PIECE(@(GLOB_"0)"),U,3)
SET SCREEN=1
SET Z0=1
SET BCS=1
+5 IF SLCOUNT=""
SET SLCOUNT=0
+6 WRITE !,FRNAME," IS OPEN AT LINE ",SLCOUNT,!,"USE |CTRL-A| | 1 | AND |CTRL-A| | 0 | TO CONTROL SCREEN SAVING, SAVING IS ON",!,"------->>ON-LINE MODE<<",!
+7 QUIT
CLOSE ; --- CLOSE SLIDE
+1 SET @(GLOB_"0)")=U_U_SLCOUNT_U_SLCOUNT_U_DT
+2 SET $PIECE(@(SLDIC_"0)"),U,2)="N"
+3 SET SCREEN=0
+4 WRITE !,FRNAME," IS CLOSED AT LINE ",SLCOUNT
+5 QUIT
STUFF ; STUFF ONE SLIDE INTO ANOTHER
+1 WRITE !!,"SOURCE ?",!
DO S1
IF Y'>0
GOTO SEXIT
SET G1=GLOB
WRITE !!,"TARGET ?",!
DO S1
IF Y'>0
GOTO SEXIT
SET G2=GLOB
+2 SET %X=G1
SET %Y=G2
DO %XY^%RCR
SEXIT KILL G1,G2,NODE,FRNAME,GLOB,NAMEDIC
QUIT
S1 SET DIC="^KLAS(1200.1,"
SET DIC(0)="AEQLZN"
DO ^DIC
WRITE !
+1 SET NAMDIC=DIC
+2 IF X="^"!(Y<0)
KILL DIC,NAMDIC
WRITE !,"NO SELECTION ... YOU ARE RETURNED TO YOUR APPLICATION",!
QUIT
+3 SET DA(1)=+Y
FRAME1 ; --- select slide ----
+1 SET DIC=NAMDIC_DA(1)_",1,"
SET DIC(0)="AEQLZN"
+2 SET NODE=DIC_"0)"
SET $PIECE(@NODE,"^",2)="1200.11I"
KILL NODE
+3 SET DIC("A")="Select SLIDE: "
+4 DO ^DIC
+5 KILL DIC("A")
+6 IF X="^"
GOTO STUFF
IF Y<0
GOTO STUFF
OPEN1 ; --- open slide ---
+1 SET FRNAME=$PIECE(Y,U,2)
SET DIE=DIC
SET DA=+Y
SET DR="10///S"
DO ^DIE
SET DIC=DIE
SET Y=DA
KILL DIE
+2 SET GLOB=DIC_+Y_",""W"","
QUIT
XRAY ;
+1 ;
DO QUES
FOR I=START:1:END
SET X=^KLAS("TEST",I)
WRITE !,I,?5,$LENGTH(X),!
FOR J=1:1:$LENGTH(X)
SET Z=$EXTRACT(X,J)
WRITE $SELECT($ASCII(Z)>32:Z,1:"."_$ASCII(Z)_".")
+2 QUIT
XX ;
+1 ;
DO QUES
FOR I=START:1:END
WRITE ^KLAS("TEST",I)
+2 QUIT
QUES READ !,"START ? ",START:30
READ " END ? ",END:30
WRITE !
QUIT
PRT QUIT
