GMTSRS ; SLC/KER - Health Summary Type Resequence ; 02/11/2003
;;2.7;Health Summary;**62**;Oct 20, 1995
;
; External References
; DBIA 10011 ^UTILITY($J
; DBIA 10013 IX1^DIK
; DBIA 10026 ^DIR
; DBIA 10011 ^DIWP
;
; This routine will resequence the Health Summary Components
; in the structure (sub-file 142.01) of a Health Summary
; Type (file 142)
;
EN ; Main Entry Point
N DA,DIK,GMTST,GMTSS,GMTSERR,GMTSCC,X,Y
W !,"Resequence the Components and/or Selection Items of a Health Summary Type.",!
D LKT^GMTSRS1 I +Y'>0 W !,"Health Summary Type not selected ",! Q
S GMTST=+Y,DA(1)=GMTST D RC(GMTST),RSI(GMTST)
K DA S DA=GMTST,DIK="^GMT(142," D IX1^DIK
Q
RC(TYPE) ; Resequence Components
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSNN,GMTSNC,GMTSTX,GMTSC,GMTSCI,GMTSCP,GMTSCN,GMTSI,GMTS,GMTSRO,GMTST,GMTSTR,GMTSCC
N %,I,X,Y,Z,DIWL,DIWR,DIWF,DIW,DIWI,DIWT,DIWTC,DIWX,DN,DA
S GMTST=+($G(TYPE)) Q:+GMTST=0 Q:'$D(^GMT(142,+GMTST,0)) Q:'$L($P($G(^GMT(142,+GMTST,0)),"^",1)) S U="^",GMTSCC=$$CS(GMTST) Q:+GMTSCC'>1
S (GMTSTX,X)="Health Summary Type '"_$P($G(^GMT(142,+GMTST,0)),"^",1)_"' has "_GMTSCC_" Health Summary Components, do you want to resequence them now?"
K ^UTILITY($J,"W") S DIWL=0,DIWF="C60" D ^DIWP S GMTSNN="^UTILITY("_$J_",""W"")",GMTSNC="^UTILITY("_$J_",""W"","
S GMTSC=0 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) I GMTSNN'["""W"",0)" S GMTSC=GMTSC+1,DIR("A",GMTSC)=@GMTSNN
Q:+GMTSC'>0 K ^UTILITY($J,"W") S DIR("A")=$G(DIR("A",GMTSC))_" (Y/N) " K DIR("A",GMTSC)
W ! S (GMTSCN,GMTSCI)=0,GMTSCP="" F S GMTSCI=$O(^GMT(142,+GMTST,1,GMTSCI)) Q:+GMTSCI=0 D
. S GMTSCP=+($P($G(^GMT(142,+GMTST,1,GMTSCI,0)),"^",2)) Q:+GMTSCP'>0
. S GMTSCP=$P($G(^GMT(142.1,+GMTSCP,0)),"^",1) Q:'$L(GMTSCP)
. S GMTSCN=+($G(GMTSCN))+1 W !,?1,$J(GMTSCN,3)," ",GMTSCP
S DIR(0)="YAO",DIR("?")="^D YN^GMTSRS3",DIR("??")="^D SC^GMTSRS3",DIR("B")="N"
W ! D ^DIR S GMTSRO=0 S:+($G(Y))>0 GMTSRO=1 W ! S DA(1)=+($G(GMTST)) D RCS^GMTSRS1
Q
RSI(TYPE) ; Resequence Selection Items
N DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSNN,GMTSNC,GMTSS,GMTSSI,GMTSTX
N GMTSC,GMTSCI,GMTSCP,GMTSCN,GMTSI,GMTS,GMTSRO,GMTST,GMTSTR,GMTSCC,%,I,X,Y,Z
N DIWL,DIWR,DIWF,DIW,DIWI,DIWT,DIWTC,DIWX,DN,DA
S GMTST=+($G(TYPE)) Q:+GMTST=0 Q:'$D(^GMT(142,+GMTST,0))
Q:'$L($P($G(^GMT(142,+GMTST,0)),"^",1))
S U="^",GMTSCC=$$CSI(GMTST) Q:+GMTSCC'>0
S X="Health Summary Type '"_$P($G(^GMT(142,+GMTST,0)),"^",1)
S X=X_"' has "_$S(+GMTSCC>1:GMTSCC,1:"one")_" Health Summary Component"_$S(+GMTSCC>1:"s",1:"")
S X=X_" with multiple selection items."
S:GMTSCC=1 X=X_" Do you want to resequence those selection items now?"
S:GMTSCC>1 X=X_" Do you want to resequence any of those selection items now?"
K ^UTILITY($J,"W") S DIWL=0,DIWF="C60" D ^DIWP S GMTSNN="^UTILITY("_$J_",""W"")",GMTSNC="^UTILITY("_$J_",""W"","
S GMTSC=0 F S GMTSNN=$Q(@GMTSNN) Q:GMTSNN=""!(GMTSNN'[GMTSNC) I GMTSNN'["""W"",0)" S GMTSC=GMTSC+1,DIR("A",GMTSC)=@GMTSNN
Q:+GMTSC'>0 K ^UTILITY($J,"W") S DIR("A")=$G(DIR("A",GMTSC))_" (Y/N) " K DIR("A",GMTSC)
S (GMTSCN,GMTSCI)=0,GMTSCP="" F S GMTSCI=$O(^GMT(142,+GMTST,1,GMTSCI)) Q:+GMTSCI=0 D
. S GMTSCP=+($P($G(^GMT(142,+GMTST,1,GMTSCI,0)),"^",2)) Q:+GMTSCP'>0
. S GMTSCP=$P($G(^GMT(142.1,+GMTSCP,0)),"^",1) Q:'$L(GMTSCP)
. S (GMTSS,GMTSSI)=0 F S GMTSSI=$O(^GMT(142,+GMTST,1,+GMTSCI,1,GMTSSI)) Q:+GMTSSI=0 S GMTSS=+GMTSS+1
. Q:+GMTSS'>1 S GMTSCN=+($G(GMTSCN))+1
. W:GMTSCC=1 !,?4," ",GMTSCP
S DIR(0)="YAO",DIR("B")="N" W ! D ^DIR S GMTSRO=0 S:+($G(Y))>0 GMTSRO=1
I +($G(Y))>0 D
. S DA(1)=+($G(GMTST)) D:+GMTSCC=1 ONE(GMTST) D:+GMTSCC>1 MUL(GMTST)
I $D(GMTSRO),+($G(GMTSRO))=0 D ALL(GMTST)
Q
ALL(TYPE) ; Resequence (only) All Components Selection Items
N DA,GMTST,GMTSCN,GMTSCI,GMTSCN,GMTSCI
S GMTST=+($G(TYPE)) Q:+GMTST=0 Q:'$D(^GMT(142,+GMTST,0)) S DA(2)=+GMTST
S (DA,GMTSCN,GMTSCI)=0 F S GMTSCI=$O(^GMT(142,+GMTST,1,GMTSCI)) Q:+GMTSCI=0 D
. S DA(1)=GMTSCI Q:'$D(^GMT(142,+DA(2),1,+DA(1),1,"B")) S GMTSRO=0
. I +($G(DA(2)))>0,+($G(DA(1)))>0,$D(^GMT(142,+($G(DA(2))),1,+($G(DA(1))))) D RSI^GMTSRS2
Q
ONE(TYPE) ; Reorder/Resequence One Component Selection Items
N DA,GMTST,GMTSCN,GMTSCI,GMTSCN,GMTSCI
S GMTST=+($G(TYPE)) Q:+GMTST=0 Q:'$D(^GMT(142,+GMTST,0)) S DA(2)=+GMTST
S (DA,GMTSCN,GMTSCI)=0 F S GMTSCI=$O(^GMT(142,+GMTST,1,GMTSCI)) Q:+GMTSCI=0 D Q:+($G(DA(1)))>0
. S (GMTSS,GMTSSI)=0 F S GMTSSI=$O(^GMT(142,+GMTST,1,+GMTSCI,1,GMTSSI)) Q:+($G(DA(1)))>0 Q:+GMTSSI=0 S GMTSS=+GMTSS+1
. Q:+GMTSS'>1 S DA(1)=GMTSCI
I +($G(DA(2)))>0,+($G(DA(1)))>0,$D(^GMT(142,+($G(DA(2))),1,+($G(DA(1))))) D RSI^GMTSRS2
I +($G(DA(2)))'>0!(+($G(DA(1)))'>0)!('$D(^GMT(142,+($G(DA(2))),1,+($G(DA(1)))))) Q
Q
MUL(TYPE) ; Reorder/Resequence Multiple Components
N GMTST,GMTSCW,GMTSMAX
S GMTST=+($G(TYPE)) Q:+GMTST=0 Q:'$D(^GMT(142,+GMTST,0))
D ARY(+($G(GMTST)),.GMTSCW) S GMTSMAX=+($G(GMTSCW(0))) Q:+GMTSMAX'>1
F S X=$$MUL2(GMTST,GMTSMAX,.GMTSCW) Q:+($G(X))'>0
Q
MUL2(GMTST,GMTSMAX,GMTSCW) ; Multiple Component Selection
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTS,GMTSA,GMTSC,GMTSI,GMTSN,GMTSTR
N GMTSTX,X,Y
S DIR(0)="NAO^1:"_GMTSMAX_":0"
S (DIR("?"),DIR("??"))="^D MULH^GMTSRS"
S DIR("A",1)="The following Components have multiple Selection Items:"
S DIR("A",2)=" "
S (GMTSI,GMTSC)=0 F S GMTSI=$O(GMTSCW(GMTSI)) Q:+GMTSI=0 D
. S GMTSN=$P($G(GMTSCW(GMTSI)),"^",2) Q:'$L(GMTSN)
. S GMTSC=GMTSC+1,GMTSA=GMTSC+2,DIR("A",GMTSA)=" "_$J(GMTSC,2)_" "_GMTSN
S GMTSA=+($O(DIR("A"," "),-1))+1,DIR("A",GMTSA)=" "
S DIR("A")="To resequence Selection Items, select 1-"_GMTSMAX_": "
W ! D ^DIR
Q:+Y'>0 -1
S:X="" (X,Y)=-1 S X=-1 S:+Y>0 X=+($G(GMTSCW(+Y)))
S:$D(DIROUT)!($D(DIRUT))!($D(DTOUT))!($D(DUOUT)) X=-1
S Y=X D:+Y>0 Y(+($G(GMTST)),+Y) S DA(2)=+($G(GMTST)) S:+Y>0 DA(1)=+Y
I +($G(DA(2)))>0,+($G(DA(1)))>0,$D(^GMT(142,+($G(DA(2))),1,+($G(DA(1))))) D RSI^GMTSRS2
S GMTST=+Y
Q GMTST
MULH ; Multiple Structure Selection Help
W !!,"Select 1-"_GMTSMAX_" to resequence, or return or '^' to exit.",!
Q
Y(TYPE,COMP) ; Results for Y
N GMTSS,GMTST S GMTST=+($G(TYPE)),GMTSS=+($G(COMP)) Q:'$D(^GMT(142,+GMTST))
I +GMTSS>0,($D(^GMT(142,+($G(GMTST)),1,+GMTSS,0))) D
. S Y=+GMTSS,Y(0)=$G(^GMT(142,+($G(GMTST)),1,+GMTSS,0)),Y(142.1)=+($P($G(^GMT(142,+($G(GMTST)),1,+GMTSS,0)),"^",2))
. S Y(142.1,0)=$G(^GMT(142.1,+($P($G(^GMT(142,+($G(GMTST)),1,+GMTSS,0)),"^",2)),0))
Q
CS(X) ; Components
N GMTSI,GMTSC,GMTSCI S (GMTSC,GMTSCI)=0,GMTSI=+($G(X)) Q:+GMTSI'>0 0
F S GMTSCI=$O(^GMT(142,+GMTSI,1,GMTSCI)) Q:+GMTSCI=0 S GMTSC=GMTSC+1
S X=GMTSC Q X
;
CSI(X) ; Components with Multiple Selection Types
N GMTSI,GMTSS,GMTSSI,GMTSC,GMTSCI,GMTSEL S (GMTSEL,GMTSC,GMTSCI)=0,GMTSI=+($G(X)) Q:+GMTSI'>0 0
F S GMTSCI=$O(^GMT(142,+GMTSI,1,GMTSCI)) Q:+GMTSCI=0 D
. S (GMTSS,GMTSSI)=0
. F S GMTSSI=$O(^GMT(142,GMTSI,1,GMTSCI,1,GMTSSI)) Q:+GMTSSI=0 D
. . S GMTSS=+($G(GMTSS))+1
. S:+($G(GMTSS))>1 GMTSEL=+($G(GMTSEL))+1
S X=GMTSEL Q X
;
ARY(X,ARY) ; Array of Components with Multiple Selection Types
N GMTSI,GMTSS,GMTSSI,GMTSC,GMTSCI,GMTSEL,GMTSSN S (GMTSC,GMTSCI,GMTSSN,GMTSEL)=0,GMTSI=+($G(X)) Q:+GMTSI'>0
F S GMTSCI=$O(^GMT(142,+GMTSI,1,GMTSCI)) Q:+GMTSCI=0 D
. S (GMTSS,GMTSSI)=0 F S GMTSSI=$O(^GMT(142,GMTSI,1,GMTSCI,1,GMTSSI)) Q:+GMTSSI=0 S GMTSS=+($G(GMTSS))+1
. I +($G(GMTSS))>1 S GMTSEL=+($G(GMTSEL))+1,ARY(GMTSEL)=+GMTSCI_"^"_$P(^GMT(142.1,+($P($G(^GMT(142,+GMTSI,1,GMTSCI,0)),"^",2)),0),"^",1),ARY(0)=GMTSEL
Q
TRIM(X) ; Remove Spaces
S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRS 7714 printed Dec 13, 2024@02:00:17 Page 2
GMTSRS ; SLC/KER - Health Summary Type Resequence ; 02/11/2003
+1 ;;2.7;Health Summary;**62**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10011 ^UTILITY($J
+5 ; DBIA 10013 IX1^DIK
+6 ; DBIA 10026 ^DIR
+7 ; DBIA 10011 ^DIWP
+8 ;
+9 ; This routine will resequence the Health Summary Components
+10 ; in the structure (sub-file 142.01) of a Health Summary
+11 ; Type (file 142)
+12 ;
EN ; Main Entry Point
+1 NEW DA,DIK,GMTST,GMTSS,GMTSERR,GMTSCC,X,Y
+2 WRITE !,"Resequence the Components and/or Selection Items of a Health Summary Type.",!
+3 DO LKT^GMTSRS1
IF +Y'>0
WRITE !,"Health Summary Type not selected ",!
QUIT
+4 SET GMTST=+Y
SET DA(1)=GMTST
DO RC(GMTST)
DO RSI(GMTST)
+5 KILL DA
SET DA=GMTST
SET DIK="^GMT(142,"
DO IX1^DIK
+6 QUIT
RC(TYPE) ; Resequence Components
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSNN,GMTSNC,GMTSTX,GMTSC,GMTSCI,GMTSCP,GMTSCN,GMTSI,GMTS,GMTSRO,GMTST,GMTSTR,GMTSCC
+2 NEW %,I,X,Y,Z,DIWL,DIWR,DIWF,DIW,DIWI,DIWT,DIWTC,DIWX,DN,DA
+3 SET GMTST=+($GET(TYPE))
if +GMTST=0
QUIT
if '$DATA(^GMT(142,+GMTST,0))
QUIT
if '$LENGTH($PIECE($GET(^GMT(142,+GMTST,0)),"^",1))
QUIT
SET U="^"
SET GMTSCC=$$CS(GMTST)
if +GMTSCC'>1
QUIT
+4 SET (GMTSTX,X)="Health Summary Type '"_$PIECE($GET(^GMT(142,+GMTST,0)),"^",1)_"' has "_GMTSCC_" Health Summary Components, do you want to resequence them now?"
+5 KILL ^UTILITY($JOB,"W")
SET DIWL=0
SET DIWF="C60"
DO ^DIWP
SET GMTSNN="^UTILITY("_$JOB_",""W"")"
SET GMTSNC="^UTILITY("_$JOB_",""W"","
+6 SET GMTSC=0
FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
IF GMTSNN'["""W"",0)"
SET GMTSC=GMTSC+1
SET DIR("A",GMTSC)=@GMTSNN
+7 if +GMTSC'>0
QUIT
KILL ^UTILITY($JOB,"W")
SET DIR("A")=$GET(DIR("A",GMTSC))_" (Y/N) "
KILL DIR("A",GMTSC)
+8 WRITE !
SET (GMTSCN,GMTSCI)=0
SET GMTSCP=""
FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTST,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+9 SET GMTSCP=+($PIECE($GET(^GMT(142,+GMTST,1,GMTSCI,0)),"^",2))
if +GMTSCP'>0
QUIT
+10 SET GMTSCP=$PIECE($GET(^GMT(142.1,+GMTSCP,0)),"^",1)
if '$LENGTH(GMTSCP)
QUIT
+11 SET GMTSCN=+($GET(GMTSCN))+1
WRITE !,?1,$JUSTIFY(GMTSCN,3)," ",GMTSCP
End DoDot:1
+12 SET DIR(0)="YAO"
SET DIR("?")="^D YN^GMTSRS3"
SET DIR("??")="^D SC^GMTSRS3"
SET DIR("B")="N"
+13 WRITE !
DO ^DIR
SET GMTSRO=0
if +($GET(Y))>0
SET GMTSRO=1
WRITE !
SET DA(1)=+($GET(GMTST))
DO RCS^GMTSRS1
+14 QUIT
RSI(TYPE) ; Resequence Selection Items
+1 NEW DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSNN,GMTSNC,GMTSS,GMTSSI,GMTSTX
+2 NEW GMTSC,GMTSCI,GMTSCP,GMTSCN,GMTSI,GMTS,GMTSRO,GMTST,GMTSTR,GMTSCC,%,I,X,Y,Z
+3 NEW DIWL,DIWR,DIWF,DIW,DIWI,DIWT,DIWTC,DIWX,DN,DA
+4 SET GMTST=+($GET(TYPE))
if +GMTST=0
QUIT
if '$DATA(^GMT(142,+GMTST,0))
QUIT
+5 if '$LENGTH($PIECE($GET(^GMT(142,+GMTST,0)),"^",1))
QUIT
+6 SET U="^"
SET GMTSCC=$$CSI(GMTST)
if +GMTSCC'>0
QUIT
+7 SET X="Health Summary Type '"_$PIECE($GET(^GMT(142,+GMTST,0)),"^",1)
+8 SET X=X_"' has "_$SELECT(+GMTSCC>1:GMTSCC,1:"one")_" Health Summary Component"_$SELECT(+GMTSCC>1:"s",1:"")
+9 SET X=X_" with multiple selection items."
+10 if GMTSCC=1
SET X=X_" Do you want to resequence those selection items now?"
+11 if GMTSCC>1
SET X=X_" Do you want to resequence any of those selection items now?"
+12 KILL ^UTILITY($JOB,"W")
SET DIWL=0
SET DIWF="C60"
DO ^DIWP
SET GMTSNN="^UTILITY("_$JOB_",""W"")"
SET GMTSNC="^UTILITY("_$JOB_",""W"","
+13 SET GMTSC=0
FOR
SET GMTSNN=$QUERY(@GMTSNN)
if GMTSNN=""!(GMTSNN'[GMTSNC)
QUIT
IF GMTSNN'["""W"",0)"
SET GMTSC=GMTSC+1
SET DIR("A",GMTSC)=@GMTSNN
+14 if +GMTSC'>0
QUIT
KILL ^UTILITY($JOB,"W")
SET DIR("A")=$GET(DIR("A",GMTSC))_" (Y/N) "
KILL DIR("A",GMTSC)
+15 SET (GMTSCN,GMTSCI)=0
SET GMTSCP=""
FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTST,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+16 SET GMTSCP=+($PIECE($GET(^GMT(142,+GMTST,1,GMTSCI,0)),"^",2))
if +GMTSCP'>0
QUIT
+17 SET GMTSCP=$PIECE($GET(^GMT(142.1,+GMTSCP,0)),"^",1)
if '$LENGTH(GMTSCP)
QUIT
+18 SET (GMTSS,GMTSSI)=0
FOR
SET GMTSSI=$ORDER(^GMT(142,+GMTST,1,+GMTSCI,1,GMTSSI))
if +GMTSSI=0
QUIT
SET GMTSS=+GMTSS+1
+19 if +GMTSS'>1
QUIT
SET GMTSCN=+($GET(GMTSCN))+1
+20 if GMTSCC=1
WRITE !,?4," ",GMTSCP
End DoDot:1
+21 SET DIR(0)="YAO"
SET DIR("B")="N"
WRITE !
DO ^DIR
SET GMTSRO=0
if +($GET(Y))>0
SET GMTSRO=1
+22 IF +($GET(Y))>0
Begin DoDot:1
+23 SET DA(1)=+($GET(GMTST))
if +GMTSCC=1
DO ONE(GMTST)
if +GMTSCC>1
DO MUL(GMTST)
End DoDot:1
+24 IF $DATA(GMTSRO)
IF +($GET(GMTSRO))=0
DO ALL(GMTST)
+25 QUIT
ALL(TYPE) ; Resequence (only) All Components Selection Items
+1 NEW DA,GMTST,GMTSCN,GMTSCI,GMTSCN,GMTSCI
+2 SET GMTST=+($GET(TYPE))
if +GMTST=0
QUIT
if '$DATA(^GMT(142,+GMTST,0))
QUIT
SET DA(2)=+GMTST
+3 SET (DA,GMTSCN,GMTSCI)=0
FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTST,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+4 SET DA(1)=GMTSCI
if '$DATA(^GMT(142,+DA(2),1,+DA(1),1,"B"))
QUIT
SET GMTSRO=0
+5 IF +($GET(DA(2)))>0
IF +($GET(DA(1)))>0
IF $DATA(^GMT(142,+($GET(DA(2))),1,+($GET(DA(1)))))
DO RSI^GMTSRS2
End DoDot:1
+6 QUIT
ONE(TYPE) ; Reorder/Resequence One Component Selection Items
+1 NEW DA,GMTST,GMTSCN,GMTSCI,GMTSCN,GMTSCI
+2 SET GMTST=+($GET(TYPE))
if +GMTST=0
QUIT
if '$DATA(^GMT(142,+GMTST,0))
QUIT
SET DA(2)=+GMTST
+3 SET (DA,GMTSCN,GMTSCI)=0
FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTST,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+4 SET (GMTSS,GMTSSI)=0
FOR
SET GMTSSI=$ORDER(^GMT(142,+GMTST,1,+GMTSCI,1,GMTSSI))
if +($GET(DA(1)))>0
QUIT
if +GMTSSI=0
QUIT
SET GMTSS=+GMTSS+1
+5 if +GMTSS'>1
QUIT
SET DA(1)=GMTSCI
End DoDot:1
if +($GET(DA(1)))>0
QUIT
+6 IF +($GET(DA(2)))>0
IF +($GET(DA(1)))>0
IF $DATA(^GMT(142,+($GET(DA(2))),1,+($GET(DA(1)))))
DO RSI^GMTSRS2
+7 IF +($GET(DA(2)))'>0!(+($GET(DA(1)))'>0)!('$DATA(^GMT(142,+($GET(DA(2))),1,+($GET(DA(1))))))
QUIT
+8 QUIT
MUL(TYPE) ; Reorder/Resequence Multiple Components
+1 NEW GMTST,GMTSCW,GMTSMAX
+2 SET GMTST=+($GET(TYPE))
if +GMTST=0
QUIT
if '$DATA(^GMT(142,+GMTST,0))
QUIT
+3 DO ARY(+($GET(GMTST)),.GMTSCW)
SET GMTSMAX=+($GET(GMTSCW(0)))
if +GMTSMAX'>1
QUIT
+4 FOR
SET X=$$MUL2(GMTST,GMTSMAX,.GMTSCW)
if +($GET(X))'>0
QUIT
+5 QUIT
MUL2(GMTST,GMTSMAX,GMTSCW) ; Multiple Component Selection
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTS,GMTSA,GMTSC,GMTSI,GMTSN,GMTSTR
+2 NEW GMTSTX,X,Y
+3 SET DIR(0)="NAO^1:"_GMTSMAX_":0"
+4 SET (DIR("?"),DIR("??"))="^D MULH^GMTSRS"
+5 SET DIR("A",1)="The following Components have multiple Selection Items:"
+6 SET DIR("A",2)=" "
+7 SET (GMTSI,GMTSC)=0
FOR
SET GMTSI=$ORDER(GMTSCW(GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+8 SET GMTSN=$PIECE($GET(GMTSCW(GMTSI)),"^",2)
if '$LENGTH(GMTSN)
QUIT
+9 SET GMTSC=GMTSC+1
SET GMTSA=GMTSC+2
SET DIR("A",GMTSA)=" "_$JUSTIFY(GMTSC,2)_" "_GMTSN
End DoDot:1
+10 SET GMTSA=+($ORDER(DIR("A"," "),-1))+1
SET DIR("A",GMTSA)=" "
+11 SET DIR("A")="To resequence Selection Items, select 1-"_GMTSMAX_": "
+12 WRITE !
DO ^DIR
+13 if +Y'>0
QUIT -1
+14 if X=""
SET (X,Y)=-1
SET X=-1
if +Y>0
SET X=+($GET(GMTSCW(+Y)))
+15 if $DATA(DIROUT)!($DATA(DIRUT))!($DATA(DTOUT))!($DATA(DUOUT))
SET X=-1
+16 SET Y=X
if +Y>0
DO Y(+($GET(GMTST)),+Y)
SET DA(2)=+($GET(GMTST))
if +Y>0
SET DA(1)=+Y
+17 IF +($GET(DA(2)))>0
IF +($GET(DA(1)))>0
IF $DATA(^GMT(142,+($GET(DA(2))),1,+($GET(DA(1)))))
DO RSI^GMTSRS2
+18 SET GMTST=+Y
+19 QUIT GMTST
MULH ; Multiple Structure Selection Help
+1 WRITE !!,"Select 1-"_GMTSMAX_" to resequence, or return or '^' to exit.",!
+2 QUIT
Y(TYPE,COMP) ; Results for Y
+1 NEW GMTSS,GMTST
SET GMTST=+($GET(TYPE))
SET GMTSS=+($GET(COMP))
if '$DATA(^GMT(142,+GMTST))
QUIT
+2 IF +GMTSS>0
IF ($DATA(^GMT(142,+($GET(GMTST)),1,+GMTSS,0)))
Begin DoDot:1
+3 SET Y=+GMTSS
SET Y(0)=$GET(^GMT(142,+($GET(GMTST)),1,+GMTSS,0))
SET Y(142.1)=+($PIECE($GET(^GMT(142,+($GET(GMTST)),1,+GMTSS,0)),"^",2))
+4 SET Y(142.1,0)=$GET(^GMT(142.1,+($PIECE($GET(^GMT(142,+($GET(GMTST)),1,+GMTSS,0)),"^",2)),0))
End DoDot:1
+5 QUIT
CS(X) ; Components
+1 NEW GMTSI,GMTSC,GMTSCI
SET (GMTSC,GMTSCI)=0
SET GMTSI=+($GET(X))
if +GMTSI'>0
QUIT 0
+2 FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTSI,1,GMTSCI))
if +GMTSCI=0
QUIT
SET GMTSC=GMTSC+1
+3 SET X=GMTSC
QUIT X
+4 ;
CSI(X) ; Components with Multiple Selection Types
+1 NEW GMTSI,GMTSS,GMTSSI,GMTSC,GMTSCI,GMTSEL
SET (GMTSEL,GMTSC,GMTSCI)=0
SET GMTSI=+($GET(X))
if +GMTSI'>0
QUIT 0
+2 FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTSI,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+3 SET (GMTSS,GMTSSI)=0
+4 FOR
SET GMTSSI=$ORDER(^GMT(142,GMTSI,1,GMTSCI,1,GMTSSI))
if +GMTSSI=0
QUIT
Begin DoDot:2
+5 SET GMTSS=+($GET(GMTSS))+1
End DoDot:2
+6 if +($GET(GMTSS))>1
SET GMTSEL=+($GET(GMTSEL))+1
End DoDot:1
+7 SET X=GMTSEL
QUIT X
+8 ;
ARY(X,ARY) ; Array of Components with Multiple Selection Types
+1 NEW GMTSI,GMTSS,GMTSSI,GMTSC,GMTSCI,GMTSEL,GMTSSN
SET (GMTSC,GMTSCI,GMTSSN,GMTSEL)=0
SET GMTSI=+($GET(X))
if +GMTSI'>0
QUIT
+2 FOR
SET GMTSCI=$ORDER(^GMT(142,+GMTSI,1,GMTSCI))
if +GMTSCI=0
QUIT
Begin DoDot:1
+3 SET (GMTSS,GMTSSI)=0
FOR
SET GMTSSI=$ORDER(^GMT(142,GMTSI,1,GMTSCI,1,GMTSSI))
if +GMTSSI=0
QUIT
SET GMTSS=+($GET(GMTSS))+1
+4 IF +($GET(GMTSS))>1
SET GMTSEL=+($GET(GMTSEL))+1
SET ARY(GMTSEL)=+GMTSCI_"^"_$PIECE(^GMT(142.1,+($PIECE($GET(^GMT(142,+GMTSI,1,GMTSCI,0)),"^",2)),0),"^",1)
SET ARY(0)=GMTSEL
End DoDot:1
+5 QUIT
TRIM(X) ; Remove Spaces
+1 SET X=$GET(X)
FOR
if $EXTRACT(X,1)'=" "
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+3 QUIT X
