Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KLASHOW

KLASHOW.m

Go to the documentation of this file. 
  1. KLASHOW ;GLRISC/PDW  SLIDE SHOW FOR CLASSMAN ;DEC 18,1990@13:54:58
  1.  ;;1.0;2.01
  1.  S U="^",X="T",%DT="",IOP=$I D ^%DT S DT=Y D ^%ZIS K X,Y,%DT S X=125 X ^%ZOSF("RM")
  1.  S DIC="^%ZIS(2,",DIC(0)="AQMZ",DIC("S")="I $P(^(0),U,1)[""C-""",DIC("B")=$S($D(IOST):IOST,1:"C-VT100") D ^DIC I Y'>0 W !,"Sorry, you must have a subtype !",! Q
  1.  K DIC S IOP="HOME;"_Y(0,0) D ^%ZIS S FF=IOF S X=125 X ^%ZOSF("RM")
  1.  S VN=$P(^%ZIS(2,IOST("0"),5),"^",5),VR=$P(^%ZIS(2,IOST("0"),5),"^",4)
  1.  S:VN="" VN="""""" S:VR="" VR=""""""
  1.  S KLSLDIC="^KLAS(1200.1,"
  1.  ; --- lookup presentation ---
  1.  S DIC=KLSLDIC,DIC(0)="AEQ",DIC("A")="     Which presentation do you want: " D ^DIC G:Y<0 STOP
  1.  S DIE=DIC,DA=+Y,DR="11" D ^DIE
  1.  S NIEN=DA,SEQ=@(KLSLDIC_NIEN_",""S"")"),KLSLDIC=KLSLDIC_NIEN_",1,"
  1.  K X,Y,DIC
  1.  ; --- set up sequence ---
  1.  F I=0:1 S SEQ(I)=$P(SEQ,":",I) Q:I>0&(SEQ(I)="")  S LFR=I ; SET UP SEQUENCE
  1.  ; --- get first frame ---
  1.  S TV=0,X=SEQ(1),FR=0,DIC=KLSLDIC,KLSLNF=SEQ(1)
  1.  D SEL ;**NEW CODE
  1.  Q:'$D(FR)  ;**NEW CODE
  1. A S DIC(0)="ZN" D ^DIC G:Y<0 ERROR
  1.  ; --- get frame parameters ---
  1.  S KLSLCF=$P(Y(0),U,1),KLSLTY=$P(Y(0),U,2),KLSLNF=SEQ(FR+1),KLSLPF=SEQ(FR-1),KLSLIN=+$P(Y(0),U,5)
  1.  S:KLSLTY="" KLSLTY="N"
  1.  S BUILD=$S(KLSLTY["L":1,1:0)
  1.  ; --- set frame type ---
  1.  S KLSLDIC=DIC_+Y_",""W"","
  1.  ; --- display frame ---
  1. B U IO(0) W @FF X ^%ZOSF("EOFF") D FIX1 S I1=0 F I=0:0 S I1=$N(@(KLSLDIC_I1_")")) Q:(I1=-1)!(I1'?.N)  S KLSLLI=@(KLSLDIC_I1_",0)") D LINE D:BUILD B1
  1.  G NEXT
  1. B1 ;R X:600 S X=$A(X) Q:X=94  D:X=63 HELP2 G:X=63 B1 S:(X=88)!(X=120) BUILD=0 Q
  1.  R X:DTIME S X=$E(X) D:X="?" HELP2 G:X="?" B1 S:X="" X="F" S:"^Qq"[X BUILD=0 Q
  1. NEXT ; --- find out what is next ---
  1.  S DX=69 W *13 X "F IN=1:1:DX W "" """
  1. LINE1 R A:DTIME S A=$E(A) D:A="?" HELP G LINE1:A="?" G:"Ff +"[A FWD G:"Bb-"[A BACK G:"^EeQq"[A END G:"Jj"[A JMP S:"Rr"[A X=SEQ(FR) G:$T A W *7 G NEXT
  1.  ; --- subroutines ---
  1. LINE ; line subroutine
  1.  I KLSLTY["N" D LP W ! Q:I1#23  W ?40 R X:DTIME S X=$E(X) S:X="" X=" " D:"?"[X HELP1 G:"?"[X LINE S I1=$S("-BbRr"[X:I1-46,"Xx^"[X:I1+9999,1:I1) S:I1<0 I1=0 W:"-"[X !,"**********MOVING BACKWARD**********",! W *13 Q
  1.  D LP
  1.  W !," ",!
  1. JJJ I '(I1#11) W ?40 R X:DTIME S X=$E(X) S:X="" X="F" D:"?"[X HELP1 G:"?"[X JJJ S I1=$S("-Bb"[X:I1-46,"Qq^"[X:I1+9999,1:I1) S:I1<0 I1=0 W:"-Bb"[X !,"**********MOVING BACKWARD**********",! W *13
  1.  Q
  1. LP ; PRINT LINE
  1.  F K=1:1:$L(KLSLLI) S X=$E(KLSLLI,K) D FIX W ""
  1.  Q
  1. FIX I X="~" S TV=(TV+1)#2 W @$S(TV:"@VR",1:"@VN")
  1.  E  W X
  1.  W:KLSLTY["E" " "
  1.  Q
  1. JMP X ^%ZOSF("EON") W !,*13 S DX=66 X "F IN=1:1:DX W "" """ R "to:",X:DTIME S:X="" X=FR+1 G:$E(X)="^" END
  1.  I X>0,X<(LFR+1) S FR=X,X=SEQ(X) G A
  1.  I X'="?" W *7 G SEL
  1. SEL F I=1:1:LFR W !,?10,I W ?15,$P(@(DIC_SEQ(I)_",0)"),U,1) W:I=FR "   *"
  1.  G JMP
  1. FWD G:KLSLNF="" END S X=KLSLNF S FR=FR+1 G A
  1. BACK W:KLSLPF="" *7 G:KLSLPF="" NEXT S X=KLSLPF S FR=FR-1 G A
  1. END W @FF S DX=33 X "F IN=1:1:DX W "" """ W "T H E   E N D" W !!! X ^%ZOSF("EON")
  1. STOP K VT,VN,VR,KLSLDIC,KLSLCF,KLSLTY,KLSLNF,KLSLPF,KLSLIN,KLSLLI,I,I1,J,A,X,DIE,DA,DR,DIC,IOP,FF,SEQ,NIEN,LFR,TV,FR,BUILD,DX,K,INQ,DA,Y,KLI,KLN,KLP S X=IOM X ^%ZOSF("RM") Q
  1. ERROR W !!,"ERROR" Q
  1. HELP W !!,"OPTIONS FOR THIS COMMAND",!!
  1.  W "TO ADVANCE TO NEXT SLIDE: <RET> ",!!
  1.  W "TO MOVE BACKWARD ONE SLIDE:  <->, <B>, -OR- <b>",!!
  1.  W "TO REPEAT CURRENT SLIDE:  <R>, -OR- <r>",!!
  1.  W "TO JUMP TO ANOTHER SLIDE: <J>, -OR- <j>",!!
  1.  W "TO QUIT: <^>, <Q>, -OR- <q>",!!
  1.  W ?79 Q
  1. HELP1 W !,"<->, <B> or <b> Backs Up 48 Lines",!,"<Q>, <q> or <^> Goes to end of slide",! Q
  1.  ;
  1. HELP2 W !," (^), <Q>, or <q>  -- WILL STOP LINE-BY-LINE MODE",!! Q
  1. FIX1 ;W "SLIDE NAME: ",$P(Y,U,2),?50,"NUMBER: ",FR,! H 2 W @FF Q  ; OLD LINE
  1.  ;W "SLIDE NAME: ",$P(Y,U,2),?50,"NUMBER: ",FR,! H 2 W ! Q  ; NEW LINE
  1. TEST ; TEST VALIDITY OF SEQUENCE
  1. X S KLP=0 F KLC=1:1 S KLP=$F(X,":",KLP) Q:KLP=0
  1.  F KLI=1:1:KLC S KLN=$P(X,":",KLI) D TX
  1.  K KLP,KLN,KLC
  1.  Q
  1. TX I (KLN'?.N)!(KLN<1) S X=""
  1.  E  S:'$D(@("^KLAS(1200.1,"_DA_",1,"_KLN_")")) X=""
  1.  Q