VALMXQ10 ; alb/mjk - XQORM2 for export with LM v1 ; 3/30/93
;;1;List Manager;;Aug 13, 1993
;
;
XQORM2 ; SLC/KCM - Lookup for Menu Utility ;11/18/92 15:23
;;6.7;Sidewinder;;Jan 08, 1993
EN ;From: XQORM Entry: X,XQORM Exit: X,Y,XQORM
N K K Y,OROTHER I X=" " S XQORM(0)=XQORM(0)_"X" D LAST^XQORM4 I '$L(X) S Y=-1 W:XQORM(0)["A" "??" W:XQORM(0)["A"&(XQORM(0)["\") ! Q
D UP^XQORM1 K ORUX S ORUX=X,(ORUT,ORUER,Y)=0,XQORMSF=""
F J=1:1:$L(ORUX,",") S X=$P(ORUX,",",J) D EAT,SET D:X["-" RNG^XQORM3 Q:ORUER F K=1:1:$L(X,",") I $L($P(X,",",K)) S ORUT=ORUT+1,ORUX(ORUT)=$P(X,",",K) S:$L(ORUFG) ORUX(ORUT,"=")=ORUFG S:ORUSB ORUX(ORUT,"'")=""
I 'ORUER S (ORUSQ,ORUT)=0 F I=0:0 S ORUT=$O(ORUX(ORUT)) Q:ORUT="" S X=ORUX(ORUT) D SPCL I $L(X) D LOOK^XQORM3,CHAL Q:ORUER
I +XQORM(0),+Y>XQORM(0) D:XQORM(0)["A" NE^XQORM4 S ORUER=1,Y=-1
I 'ORUER S ORUB=0 F I=0:0 S ORUB=$O(Y(ORUB)) Q:ORUB'>0 D SCRN I 'ORUFG D:ORUX["ALL" SUB I ORUX'["ALL" D:XQORM(0)["A" NS^XQORM4 S ORUER=1
I 'ORUER,Y>0 W:XQORM(0)["A" " " S ORUFG=$S($X>(IOM-30):9,1:$X) K:XQORM(0)'["F" ^DISV(DUZ,"XQORM",XQORM) F I=0:0 S I=$O(Y(I)) Q:I'>0 D:XQORM(0)["A" ECHO D:XQORM(0)'["F" DISV
S X=ORUX I ORUER K Y S Y=-1
KILL K ORUX,ORUFG,ORUSB,ORUT,ORUER,ORUFD,ORUB,ORUDA,ORUW,ORUSQ,XQORMSF,J,Y("B") Q
SCRN S ORUFG=1 I $D(XQORM("S"))'[0,$L(XQORM("S")) N DA S DA(1)=+XQORM,DA=+Y(ORUB) I DA N Y X XQORM("S") S ORUFG=$T
Q
SET S ORUSB=0 I $E(X)="-",$L(X)>1 S ORUSB=1,X=$P(X,"-",2,99)
S ORUFG="" I $E(X)'="=" S ORUFG=$P(X,"=",2,99),X=$P(X,"=",1)
Q
SPCL S:'$D(XQORSPEW) XQORSPEW=0 I $E(X)="*" S XQORSPEW=$S(XQORSPEW:0,1:1),X=$E(X,2,255) W $S(XQORSPEW:" -RAPID MODE-",1:" -NORMAL MODE-")
;I $D(XQORM("KEY",$P(X," "))) S ORUX(ORUT,"=")=$P(X," ",2,99)_"="_$G(ORUX(ORUT,"=")),X="^^`"_XQORM("KEY",$P(X," "))
I '$D(XQORM("NO^^")),$E(X,1,2)="^^" S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)="^"_X,X="" S:$D(ORUX(ORUT,"=")) $P(Y(ORUSQ),"=",2)=ORUX(ORUT,"=") Q
I XQORM(0)["+","+-"[X S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)=X,X="" Q
I $E(X)=";" D SC^XQORM4 S X="",ORUER=1 Q
S X=$P(X,";",1) D EAT
Q
CHAL Q:ORUER I ORUDA D UPD^XQORM3 Q
I $D(XQORM("KEY",$P(ORUDA," "))) D Q
. S Y=Y+1,ORUSQ=ORUSQ+1,Y(ORUSQ)="^^"_ORUDA_"^`"_+XQORM("KEY",$P(ORUDA," "))_"="_$P(ORUDA," ",2,99)_"="_$G(ORUX(ORUT,"="))
. I $P(XQORM("KEY",$P(ORUDA," ")),"^",2) S $P(Y(ORUSQ),"^",2)=+XQORM("KEY",$P(ORUDA," "))
. Q
I ORUDA="ALL" S X="ALL",ORUER=0 D ALL^XQORM4 Q
Q
EAT F I=0:0 Q:$E(X)]" " Q:'$L(X) S X=$E(X,2,999)
F I=0:0 Q:$E(X,$L(X))]" " Q:'$L(X) S X=$E(X,1,$L(X)-1)
Q
ECHO W:($X+$L($P(Y(I),"^",3))+4)>IOM !,?ORUFG W $P(Y(I),"^",3)," " Q
DISV I +Y(I) S ^DISV(DUZ,"XQORM",XQORM,I)=$P(Y(I),"^",3) Q
I XQORM(0)["R",$L($P(Y(I),"^",3)) S ^DISV(DUZ,"XQORM",XQORM,I)=$P(Y(I),"^",3) Q
I XQORM(0)["r",'$L($P(Y(I),"^",3)) S ^DISV(DUZ,"XQORM",XQORM,I)="^^"_$P(Y(I),"^",4)
Q
SUB K Y(ORUB) S Y=Y-1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVALMXQ10 2848 printed Dec 13, 2024@02:10:28 Page 2
VALMXQ10 ; alb/mjk - XQORM2 for export with LM v1 ; 3/30/93
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
+3 ;
XQORM2 ; SLC/KCM - Lookup for Menu Utility ;11/18/92 15:23
+1 ;;6.7;Sidewinder;;Jan 08, 1993
EN ;From: XQORM Entry: X,XQORM Exit: X,Y,XQORM
+1 NEW K
KILL Y,OROTHER
IF X=" "
SET XQORM(0)=XQORM(0)_"X"
DO LAST^XQORM4
IF '$LENGTH(X)
SET Y=-1
if XQORM(0)["A"
WRITE "??"
if XQORM(0)["A"&(XQORM(0)["\")
WRITE !
QUIT
+2 DO UP^XQORM1
KILL ORUX
SET ORUX=X
SET (ORUT,ORUER,Y)=0
SET XQORMSF=""
+3 FOR J=1:1:$LENGTH(ORUX,",")
SET X=$PIECE(ORUX,",",J)
DO EAT
DO SET
if X["-"
DO RNG^XQORM3
if ORUER
QUIT
FOR K=1:1:$LENGTH(X,",")
IF $LENGTH($PIECE(X,",",K))
SET ORUT=ORUT+1
SET ORUX(ORUT)=$PIECE(X,",",K)
if $LENGTH(ORUFG)
SET ORUX(ORUT,"=")=ORUFG
if ORUSB
SET ORUX(ORUT,"'")=""
+4 IF 'ORUER
SET (ORUSQ,ORUT)=0
FOR I=0:0
SET ORUT=$ORDER(ORUX(ORUT))
if ORUT=""
QUIT
SET X=ORUX(ORUT)
DO SPCL
IF $LENGTH(X)
DO LOOK^XQORM3
DO CHAL
if ORUER
QUIT
+5 IF +XQORM(0)
IF +Y>XQORM(0)
if XQORM(0)["A"
DO NE^XQORM4
SET ORUER=1
SET Y=-1
+6 IF 'ORUER
SET ORUB=0
FOR I=0:0
SET ORUB=$ORDER(Y(ORUB))
if ORUB'>0
QUIT
DO SCRN
IF 'ORUFG
if ORUX["ALL"
DO SUB
IF ORUX'["ALL"
if XQORM(0)["A"
DO NS^XQORM4
SET ORUER=1
+7 IF 'ORUER
IF Y>0
if XQORM(0)["A"
WRITE " "
SET ORUFG=$SELECT($X>(IOM-30):9,1:$X)
if XQORM(0)'["F"
KILL ^DISV(DUZ,"XQORM",XQORM)
FOR I=0:0
SET I=$ORDER(Y(I))
if I'>0
QUIT
if XQORM(0)["A"
DO ECHO
if XQORM(0)'["F"
DO DISV
+8 SET X=ORUX
IF ORUER
KILL Y
SET Y=-1
KILL KILL ORUX,ORUFG,ORUSB,ORUT,ORUER,ORUFD,ORUB,ORUDA,ORUW,ORUSQ,XQORMSF,J,Y("B")
QUIT
SCRN SET ORUFG=1
IF $DATA(XQORM("S"))'[0
IF $LENGTH(XQORM("S"))
NEW DA
SET DA(1)=+XQORM
SET DA=+Y(ORUB)
IF DA
NEW Y
XECUTE XQORM("S")
SET ORUFG=$TEST
+1 QUIT
SET SET ORUSB=0
IF $EXTRACT(X)="-"
IF $LENGTH(X)>1
SET ORUSB=1
SET X=$PIECE(X,"-",2,99)
+1 SET ORUFG=""
IF $EXTRACT(X)'="="
SET ORUFG=$PIECE(X,"=",2,99)
SET X=$PIECE(X,"=",1)
+2 QUIT
SPCL if '$DATA(XQORSPEW)
SET XQORSPEW=0
IF $EXTRACT(X)="*"
SET XQORSPEW=$SELECT(XQORSPEW:0,1:1)
SET X=$EXTRACT(X,2,255)
WRITE $SELECT(XQORSPEW:" -RAPID MODE-",1:" -NORMAL MODE-")
+1 ;I $D(XQORM("KEY",$P(X," "))) S ORUX(ORUT,"=")=$P(X," ",2,99)_"="_$G(ORUX(ORUT,"=")),X="^^`"_XQORM("KEY",$P(X," "))
+2 IF '$DATA(XQORM("NO^^"))
IF $EXTRACT(X,1,2)="^^"
SET Y=Y+1
SET ORUSQ=ORUSQ+1
SET Y(ORUSQ)="^"_X
SET X=""
if $DATA(ORUX(ORUT,"="))
SET $PIECE(Y(ORUSQ),"=",2)=ORUX(ORUT,"=")
QUIT
+3 IF XQORM(0)["+"
IF "+-"[X
SET Y=Y+1
SET ORUSQ=ORUSQ+1
SET Y(ORUSQ)=X
SET X=""
QUIT
+4 IF $EXTRACT(X)=";"
DO SC^XQORM4
SET X=""
SET ORUER=1
QUIT
+5 SET X=$PIECE(X,";",1)
DO EAT
+6 QUIT
CHAL if ORUER
QUIT
IF ORUDA
DO UPD^XQORM3
QUIT
+1 IF $DATA(XQORM("KEY",$PIECE(ORUDA," ")))
Begin DoDot:1
+2 SET Y=Y+1
SET ORUSQ=ORUSQ+1
SET Y(ORUSQ)="^^"_ORUDA_"^`"_+XQORM("KEY",$PIECE(ORUDA," "))_"="_$PIECE(ORUDA," ",2,99)_"="_$GET(ORUX(ORUT,"="))
+3 IF $PIECE(XQORM("KEY",$PIECE(ORUDA," ")),"^",2)
SET $PIECE(Y(ORUSQ),"^",2)=+XQORM("KEY",$PIECE(ORUDA," "))
+4 QUIT
End DoDot:1
QUIT
+5 IF ORUDA="ALL"
SET X="ALL"
SET ORUER=0
DO ALL^XQORM4
QUIT
+6 QUIT
EAT FOR I=0:0
if $EXTRACT(X)]" "
QUIT
if '$LENGTH(X)
QUIT
SET X=$EXTRACT(X,2,999)
+1 FOR I=0:0
if $EXTRACT(X,$LENGTH(X))]" "
QUIT
if '$LENGTH(X)
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+2 QUIT
ECHO if ($X+$LENGTH($PIECE(Y(I),"^",3))+4)>IOM
WRITE !,?ORUFG
WRITE $PIECE(Y(I),"^",3)," "
QUIT
DISV IF +Y(I)
SET ^DISV(DUZ,"XQORM",XQORM,I)=$PIECE(Y(I),"^",3)
QUIT
+1 IF XQORM(0)["R"
IF $LENGTH($PIECE(Y(I),"^",3))
SET ^DISV(DUZ,"XQORM",XQORM,I)=$PIECE(Y(I),"^",3)
QUIT
+2 IF XQORM(0)["r"
IF '$LENGTH($PIECE(Y(I),"^",3))
SET ^DISV(DUZ,"XQORM",XQORM,I)="^^"_$PIECE(Y(I),"^",4)
+3 QUIT
SUB KILL Y(ORUB)
SET Y=Y-1
QUIT
