- 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
