- XQ41 ;SEA/JLI - Diagram menus (continued) ;08/27/97 14:47 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- L G LL:'$D(^TMP($J,"XQM",XQL,L)) K X1,X2,X3 S Y=1,XQV=^(L) S:$D(^(L,.1)) X1=^(.1) S:$D(^(.2)) X2=^(.2) S:$D(^(.3)) X3=^(.3) I $D(^(1)) S XQV(L)=^(1)
- E S:$P(XQV,U,5)'="M" XQT=L
- S XQP=$P(XQV,U,1),XQP(L)=$E("-----",1,5-$L(XQP))_XQP_" ",X=$P(XQV,U,3)_" ["_$P(XQV,U,2)_"]" D T I $P(XQV,U,4)]"" S X="**UNAVAILABLE**" D T
- G:XQ4<0 LL I $P(XQV,U,7)]"" S X="**LOCKED: "_$P(XQV,U,7)_"**" D T
- I $P(XQV,U,17)]"" S X="**R-LOCK: "_$P(XQV,U,17)_"**" D T
- S XQN=$O(^DIC(19,"B",$P(XQV,U,2),0)),XQX=""
- I $D(^DIC(19,XQN,3.91)) S %XQI=0 F S %XQI=$O(^DIC(19,XQN,3.91,%XQI)) Q:%XQI'>0 S XQX=XQX_$P(^(%XQI,0),U,1)_$P(^(0),U,2)_" "
- I XQX="" S XQX=$P(XQV,U,10) I XQX'="" S XQX=XQX_"MO-FR"
- I XQX]"" S X="**PROHIBITED TIMES: "_XQX_"**" D T
- K XQX,%XQI
- I XQ4>0&$D(X3) S X="**HEADER: " D T S X=X3 D T
- I XQ4>0&$D(X1) S X="**ENTRY ACTION: " D T S X=X1 D T
- I XQ4>0&$D(X2) S X="**EXIT ACTION: " D T S X=X2 D T
- LL S Y=0,L=L+1 G L:L'>M
- Y S Y=Y+1,L=1 D:$Y+2>IOSL WAIT Q:XQFLAG=U W ! G WL:$O(Z(0))>0 S Z=XQT-1
- B I L=M Q:$D(XQV(Z))!'Z S Z=Z-1,L=1 W !
- D D S L=L+1 G B
- D Q:L'<XQT!'$D(XQV(L)) W ?W+10*(L-1)+10 I Y=1 W "|" K:XQV(L)=XQL XQV(L) F X=1:1 G Q:X=W!'$D(Z(L+1)) W "-"
- W "|" W:L<M ?W+4*L Q
- WL I '$D(Z(L,Y)) D D G O
- S XQV=Z(L,Y),XQP=XQP(L) K Z(L,Y) S:XQT'>L L=M I Y=1 F X=1:1 Q:W+10*(L-1)-1<$X W "-"
- W:Y=1 ?W+10*(L-1),XQP W ?W+10*(L-1)+6,XQV
- O S L=L+1 G Y:M<L,WL
- ;
- T S D=""
- W S Z=$P(X," ",1),X=$P(X," ",2,999) I $L(D)+$L(Z)>W,$L(D) S Z(L,Y)=D,D="",Y=Y+1
- I $L(Z)>W S Z(L,Y)=$E(Z,1,W),Z=$E(Z,W+1,99) S:$E(Z,1)=" " Z=$E(Z,2,99) S Y=Y+1
- S D=D_Z_" " G W:X]"" S Z(L,Y)=D,Y=Y+1 Q
- ;
- X Q:'$D(XQB(L))&('$D(XQBN(L))) Q:'$D(XQB(L,XQBN(L))) S Y=$G(XQB(L,XQBN(L))) Q:'$D(XQB(L,XQBN(L))) S XQBN(L)=XQBN(L)+1 I '$D(^DIC(19,+Y,0)) G X
- E Q:'$D(Y) S Z=^DIC(19,+Y,0) S:$P(Z,U,16) XI=$S('$D(^(3)):"",1:$P(^(3),U)),Z=$P(Z,U,1,15)_U_XI_U_$P(Z,U,17,99) S ^TMP($J,"XQM",XQL,L)=$P(Y,";",2)_U_Z,XQV=$P(Z,U,6) S:L>1 ^TMP($J,"XQM",XQV(L-1),L-1,1)=XQL
- F XQI=15,20,26 I $D(^DIC(19,+Y,XQI))#2,^(XQI)'="" S ^TMP($J,"XQM",XQL,L,$S(XQI=26:.3,XQI=15:.2,1:.1))=^(XQI)
- I $P(Z,U,4)'="M"!$D(^TMP($J,"XQ1",+Y))!$S(XQV]""&$D(XQDUZ):'$D(^XUSEC(XQV,XQDUZ)),1:0)!($P(Z,U,3)]"") S XQL=XQL+1 G X
- S ^TMP($J,"XQ1",+Y)="",XQV(L)=XQL,L=L+1,X(L)="",(Y,XQDIC,XQDIC(L))=+Y S:M<L M=L
- I $S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) S XQSAV=Y D ^XQSET S Y=XQSAV K XQSAV
- K XQA S XQJ=-1 F S XQJ=$O(^XUTL("XQO",Y,U,XQJ)) Q:XQJ="" S XQA($P(^(XQJ),U,2))=XQJ
- K XQB(L) S XQBN(L)=1,XQJ=+^XUTL("XQO",Y,0),XQBN1=0
- F XQI=1:1:XQJ S XQN=^XUTL("XQO",Y,0,XQI) F XQP=0:1 S XQB=$P(XQN,U,8*XQP+2) Q:'$L($P(XQN,U,8*XQP+2,99)) I XQB'="",($D(XQA(XQB))) S XQBN1=XQBN1+1,XQB(L,XQBN1)=XQA(XQB)_";"_$P(XQN,U,8*XQP+1) K XQA(XQB)
- K XQBN1
- D X
- Q:L=1 S L=L-1,XQDIC=XQDIC(L) G X
- ;
- WAIT ;
- I 1 S XQFLAG="" R:IOST["C-" !?26,"Press RETURN to continue, '^' to halt...",XQFLAG:DTIME S:'$T XQFLAG=U W @IOF
- Q Q
- ;
- XQ41 ;SEA/JLI - Diagram menus (continued) ;08/27/97 14:47 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- L IF '$DATA(^TMP($JOB,"XQM",XQL,L))
- GOTO LL
- KILL X1,X2,X3
- SET Y=1
- SET XQV=^(L)
- IF $DATA(^(L,.1))
- SET X1=^(.1)
- IF $DATA(^(.2))
- SET X2=^(.2)
- IF $DATA(^(.3))
- SET X3=^(.3)
- IF $DATA(^(1))
- SET XQV(L)=^(1)
- +1 IF '$TEST
- IF $PIECE(XQV,U,5)'="M"
- SET XQT=L
- +2 SET XQP=$PIECE(XQV,U,1)
- SET XQP(L)=$EXTRACT("-----",1,5-$LENGTH(XQP))_XQP_" "
- SET X=$PIECE(XQV,U,3)_" ["_$PIECE(XQV,U,2)_"]"
- DO T
- IF $PIECE(XQV,U,4)]""
- SET X="**UNAVAILABLE**"
- DO T
- +3 IF XQ4<0
- GOTO LL
- IF $PIECE(XQV,U,7)]""
- SET X="**LOCKED: "_$PIECE(XQV,U,7)_"**"
- DO T
- +4 IF $PIECE(XQV,U,17)]""
- SET X="**R-LOCK: "_$PIECE(XQV,U,17)_"**"
- DO T
- +5 SET XQN=$ORDER(^DIC(19,"B",$PIECE(XQV,U,2),0))
- SET XQX=""
- +6 IF $DATA(^DIC(19,XQN,3.91))
- SET %XQI=0
- FOR
- SET %XQI=$ORDER(^DIC(19,XQN,3.91,%XQI))
- IF %XQI'>0
- QUIT
- SET XQX=XQX_$PIECE(^(%XQI,0),U,1)_$PIECE(^(0),U,2)_" "
- +7 IF XQX=""
- SET XQX=$PIECE(XQV,U,10)
- IF XQX'=""
- SET XQX=XQX_"MO-FR"
- +8 IF XQX]""
- SET X="**PROHIBITED TIMES: "_XQX_"**"
- DO T
- +9 KILL XQX,%XQI
- +10 IF XQ4>0&$DATA(X3)
- SET X="**HEADER: "
- DO T
- SET X=X3
- DO T
- +11 IF XQ4>0&$DATA(X1)
- SET X="**ENTRY ACTION: "
- DO T
- SET X=X1
- DO T
- +12 IF XQ4>0&$DATA(X2)
- SET X="**EXIT ACTION: "
- DO T
- SET X=X2
- DO T
- LL SET Y=0
- SET L=L+1
- IF L'>M
- GOTO L
- Y SET Y=Y+1
- SET L=1
- IF $Y+2>IOSL
- DO WAIT
- IF XQFLAG=U
- QUIT
- WRITE !
- IF $ORDER(Z(0))>0
- GOTO WL
- SET Z=XQT-1
- B IF L=M
- IF $DATA(XQV(Z))!'Z
- QUIT
- SET Z=Z-1
- SET L=1
- WRITE !
- +1 DO D
- SET L=L+1
- GOTO B
- D IF L'<XQT!'$DATA(XQV(L))
- QUIT
- WRITE ?W+10*(L-1)+10
- IF Y=1
- WRITE "|"
- IF XQV(L)=XQL
- KILL XQV(L)
- FOR X=1:1
- IF X=W!'$DATA(Z(L+1))
- GOTO Q
- WRITE "-"
- +1 WRITE "|"
- IF L<M
- WRITE ?W+4*L
- QUIT
- WL IF '$DATA(Z(L,Y))
- DO D
- GOTO O
- +1 SET XQV=Z(L,Y)
- SET XQP=XQP(L)
- KILL Z(L,Y)
- IF XQT'>L
- SET L=M
- IF Y=1
- FOR X=1:1
- IF W+10*(L-1)-1<$X
- QUIT
- WRITE "-"
- +2 IF Y=1
- WRITE ?W+10*(L-1),XQP
- WRITE ?W+10*(L-1)+6,XQV
- O SET L=L+1
- IF M<L
- GOTO Y
- GOTO WL
- +1 ;
- T SET D=""
- W SET Z=$PIECE(X," ",1)
- SET X=$PIECE(X," ",2,999)
- IF $LENGTH(D)+$LENGTH(Z)>W
- IF $LENGTH(D)
- SET Z(L,Y)=D
- SET D=""
- SET Y=Y+1
- +1 IF $LENGTH(Z)>W
- SET Z(L,Y)=$EXTRACT(Z,1,W)
- SET Z=$EXTRACT(Z,W+1,99)
- IF $EXTRACT(Z,1)=" "
- SET Z=$EXTRACT(Z,2,99)
- SET Y=Y+1
- +2 SET D=D_Z_" "
- IF X]""
- GOTO W
- SET Z(L,Y)=D
- SET Y=Y+1
- QUIT
- +3 ;
- X IF '$DATA(XQB(L))&('$DATA(XQBN(L)))
- QUIT
- IF '$DATA(XQB(L,XQBN(L)))
- QUIT
- SET Y=$GET(XQB(L,XQBN(L)))
- IF '$DATA(XQB(L,XQBN(L)))
- QUIT
- SET XQBN(L)=XQBN(L)+1
- IF '$DATA(^DIC(19,+Y,0))
- GOTO X
- E IF '$DATA(Y)
- QUIT
- SET Z=^DIC(19,+Y,0)
- IF $PIECE(Z,U,16)
- SET XI=$SELECT('$DATA(^(3)):"",1:$PIECE(^(3),U))
- SET Z=$PIECE(Z,U,1,15)_U_XI_U_$PIECE(Z,U,17,99)
- SET ^TMP($JOB,"XQM",XQL,L)=$PIECE(Y,";",2)_U_Z
- SET XQV=$PIECE(Z,U,6)
- IF L>1
- SET ^TMP($JOB,"XQM",XQV(L-1),L-1,1)=XQL
- +1 FOR XQI=15,20,26
- IF $DATA(^DIC(19,+Y,XQI))#2
- IF ^(XQI)'=""
- SET ^TMP($JOB,"XQM",XQL,L,$SELECT(XQI=26:.3,XQI=15:.2,1:.1))=^(XQI)
- +2 IF $PIECE(Z,U,4)'="M"!$DATA(^TMP($JOB,"XQ1",+Y))!$SELECT(XQV]""&$DATA(XQDUZ):'$DATA(^XUSEC(XQV,XQDUZ)),1:0)!($PIECE(Z,U,3)]"")
- SET XQL=XQL+1
- GOTO X
- +3 SET ^TMP($JOB,"XQ1",+Y)=""
- SET XQV(L)=XQL
- SET L=L+1
- SET X(L)=""
- SET (Y,XQDIC,XQDIC(L))=+Y
- IF M<L
- SET M=L
- +4 IF $SELECT('$DATA(^XUTL("XQO",XQDIC,0)):1,'$DATA(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$PIECE(^XUTL("XQO",XQDIC,0),U,2))
- SET XQSAV=Y
- DO ^XQSET
- SET Y=XQSAV
- KILL XQSAV
- +5 KILL XQA
- SET XQJ=-1
- FOR
- SET XQJ=$ORDER(^XUTL("XQO",Y,U,XQJ))
- IF XQJ=""
- QUIT
- SET XQA($PIECE(^(XQJ),U,2))=XQJ
- +6 KILL XQB(L)
- SET XQBN(L)=1
- SET XQJ=+^XUTL("XQO",Y,0)
- SET XQBN1=0
- +7 FOR XQI=1:1:XQJ
- SET XQN=^XUTL("XQO",Y,0,XQI)
- FOR XQP=0:1
- SET XQB=$PIECE(XQN,U,8*XQP+2)
- IF '$LENGTH($PIECE(XQN,U,8*XQP+2,99))
- QUIT
- IF XQB'=""
- IF ($DATA(XQA(XQB)))
- SET XQBN1=XQBN1+1
- SET XQB(L,XQBN1)=XQA(XQB)_";"_$PIECE(XQN,U,8*XQP+1)
- KILL XQA(XQB)
- +8 KILL XQBN1
- +9 DO X
- +10 IF L=1
- QUIT
- SET L=L-1
- SET XQDIC=XQDIC(L)
- GOTO X
- +11 ;
- WAIT ;
- +1 IF 1
- SET XQFLAG=""
- IF IOST["C-"
- READ !?26,"Press RETURN to continue, '^' to halt...",XQFLAG:DTIME
- IF '$TEST
- SET XQFLAG=U
- WRITE @IOF
- Q QUIT
- +1 ;
