- 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
- 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
