GMTSRS2.m

GMTSRS2 ; SLC/KER - Selection Items Resequence      ; 02/11/2003 [6/13/03 10:30am]

 ;;2.7;Health Summary;**62**;Oct 20, 1995

 ;

 ; External References

 ;   DBIA 10076  ^XUSEC(

 ;   DBIA 10076  ^XUSEC("GMTSMGR"

 ;   DBIA 10026  ^DIR

 ;   DBIA 10006  ^DIC  (file #142)

 ;   DBIA  2054  $$CREF^DILF

 ;   DBIA 10013  IX1^DIK

 ;          

 ; This routine will resequence the selection items (sub-file 

 ; 142.14) of a Health Component in the structure (sub-file 

 ; 142.01) of a Health Summary Type (file 142)

 ;          

EN ; Main Entry Point

 N DA,GMTST,GMTSS,GMTSERR,X,Y D LKT Q:+Y'>0  S GMTST=+Y D LKS Q:+Y'>0  S GMTSS=+Y

 S DA(2)=GMTST,DA(1)=GMTSS D RSI

 Q

RSI ; Resequence Selection Items

 N ARY,INA,OPA,X,Y,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSO,GMTS1

 N GMTSAC,GMTSAI,GMTSC,GMTSCHG,GMTSCOL,GMTSERR,GMTSF,GMTSHDR,GMTSI

 N GMTSI1,GMTSI2,GMTSIN,GMTSINM,GMTSKEY,GMTSLOCK,GMTSMAX

 N GMTSMGR,GMTSO,GMTSON,GMTSOP,GMTSPIE,GMTSRO,GMTSROOT,GMTSS

 N GMTST,GMTSU,GMTSVAL,GMTSY W ! K ARY,INA,OPA

 D INA^GMTSRS2B(DA(2),DA(1),.ARY)

 S GMTSINM=$$MAX(.ARY)

 I +GMTSINM'>0 D  Q

 . I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0)) W !,"Can not resequence, no selection items found."

 I +GMTSINM'>1 I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0)) W !,"Resequencing not required (1 item)"

 F  D RESEQ(.ARY)  Q:'$D(ARY)

 S GMTSMAX=$$MAX(.OPA)

 I +GMTSINM'=+GMTSMAX I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0)) W !,"Selection items not resequenced (sequence not fully specified)" Q

 D:+GMTSMAX>0 VER(.INA,.OPA,DA(2),DA(1))

 Q

 ;          

RESEQ(ARY) ; Resequence - .ARY

 N GMTSNXT,GMTSI,GMTSIN,GMTSOP,GMTS0,GMTS1,GMTSAC,GMTSAI,GMTSMAX S GMTSMAX=$$MAX(.ARY)

 S (GMTSAI,GMTSAC)=0 F  S GMTSAI=$O(ARY(GMTSAI)) Q:+GMTSAI=0  S GMTSAC=+($G(GMTSAC))+1

 D RES^GMTSRS2B(.ARY) S (GMTSAI,GMTSAC)=0 F  S GMTSAI=$O(ARY(GMTSAI)) Q:+GMTSAI=0  S GMTSAC=+($G(GMTSAC))+1

 I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0))&(GMTSMAX>72) W !,"Resequence selection items:",!

 I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0))&(GMTSMAX>72) D DIS^GMTSRS2B(.ARY)

 I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0))&(GMTSMAX'>72) D

 . N GMTSROOT,GMTSNODE,GMTSPIE,GMTSHDR,GMTSCOL S ARY(0)=$G(GMTSMAX)

 . S GMTSROOT="ARY",GMTSHDR="Resequence selection items:",GMTSNODE=1,GMTSPIE=2

 . S GMTSCOL=1 S:+GMTSMAX>18 GMTSCOL=2 S:+GMTSMAX>36 GMTSCOL=3 S:+GMTSMAX>54 GMTSCOL=4 S:+GMTSMAX>72 GMTSCOL=5 S:+GMTSMAX>90 GMTSCOL=6

 . D EN^GMTSRS4(GMTSROOT,GMTSNODE,GMTSPIE,GMTSHDR,GMTSCOL)

 S GMTSNXT=$$ASK(.ARY,.GMTSNXT) F  Q:$E(GMTSNXT,$L(GMTSNXT))'=","  S GMTSNXT=$E(GMTSNXT,1,($L(GMTSNXT)-1))

 K:+GMTSNXT'>0 ARY Q:+GMTSNXT'>0

 S GMTSI=0 F GMTSI=1:1 Q:+($P(GMTSNXT,",",GMTSI))'>0  D

 . N GMTSIN,GMTSOP,GMTS0,GMTS1 S GMTSIN=+($P(GMTSNXT,",",GMTSI))

 . S GMTS0=$G(ARY(GMTSIN)) S GMTS1=$G(ARY(GMTSIN,1))

 . K ARY(GMTSIN) Q:'$L(GMTS0)  Q:'$L(GMTS1)

 . S GMTSOP=+($O(OPA(" "),-1))+1,OPA(GMTSOP)=GMTS0

 . S OPA(GMTSOP,1)=GMTS1 K ARY(GMTSIN)

 S GMTSA1=1

 F  S GMTSNXT=$G(GMTSNXT(GMTSA1)) Q:+$G(GMTSNXT)=0  D

 .S GMTSI=0 F GMTSI=1:1 Q:+($P(GMTSNXT,",",GMTSI))'>0  D

 .. N GMTSIN,GMTSOP,GMTS0,GMTS1 S GMTSIN=+($P(GMTSNXT,",",GMTSI))

 .. S GMTS0=$G(ARY(GMTSIN)) S GMTS1=$G(ARY(GMTSIN,1))

 .. K ARY(GMTSIN) Q:'$L(GMTS0)  Q:'$L(GMTS1)

 .. S GMTSOP=+($O(OPA(" "),-1))+1,OPA(GMTSOP)=GMTS0

 .. S OPA(GMTSOP,1)=GMTS1 K ARY(GMTSIN)

 .S GMTSA1=GMTSA1+1

 Q

 ;          

ASK(ARY,NEXT,X) ; Ask for order of Selection Items

 N DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSMAX,Y,GMTSF,GMTSI S GMTSMAX=$$MAX(.ARY) Q:+GMTSMAX=1 1  Q:+GMTSMAX'>0 ""

 F GMTSI=1:1:GMTSMAX S GMTSF=$G(GMTSF)_GMTSI_","

 I $D(GMTSRO),+GMTSRO=0 S X=GMTSF Q X

 S DIR(0)="LAO^1:"_GMTSMAX_":0",DIR("A")="Select next item(s)" S:GMTSMAX>1 DIR("A")=DIR("A")_" 1-"_GMTSMAX

 S DIR("?",1)="Specify a set of Selection Items: eg 2-9,1,10-15"

 S DIR("?",2)="          You must use every Selection Item in the set"

 S DIR("?",3)="          For example, if there are 20 Selection Items"

 S DIR("?",4)="            every number from 1 to 20 must be included"

 S DIR("?")="            in the resulting set. eg 10-20,5-9,1-4"

 S DIR("A")=DIR("A")_":  ",DIR("B")=1 W ! D ^DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) K ARY S X=-1 Q X

 M NEXT=Y

 S X=Y Q X

 ;

MAX(ARY,X) ; Maximum # Items

 N GMTSI S (GMTSI,X)=0 F  S GMTSI=$O(ARY(GMTSI)) Q:+GMTSI=0  S X=X+1

 S ARY(0)=X Q X

 ;          

VER(INA,OPA,GMTST,GMTSS) ; Verify Resequence

 N GMTSI2,GMTSI1,GMTSI,GMTSC,GMTSON,GMTSNN,GMTSCHG,GMTSVAL,GMTSTR,GMTSCT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT

 S GMTSI2=+($G(GMTST)) Q:+GMTSI2=0  S GMTSI1=+($G(GMTSS)) Q:+GMTSI1=0

 I $D(GMTSRO),+GMTSRO=0 G VER2

 S (GMTSI,GMTSC,GMTSCHG)=0 F  S GMTSI=$O(INA(GMTSI)) Q:+GMTSI=0  D

 . S GMTSON=$P($G(INA(GMTSI,1)),"^",2)

 . S GMTSNN=$P($G(OPA(GMTSI,1)),"^",2) S:GMTSON'=GMTSNN GMTSCHG=1

 I 'GMTSCHG I '$D(GMTSRO)!($D(GMTSRO)&(+($G(GMTSRO))>0)) W !,"No changes in the Selection Item sequence." S GMTSRO=0 G VER2

 S GMTSCT=0 F  S GMTSI=$O(INA(GMTSI)) Q:+GMTSI=0  D

 . S GMTSON=$P($G(INA(GMTSI,1)),"^",2),GMTSNN=$P($G(OPA(GMTSI,1)),"^",2) Q:'$L(GMTSON)  Q:'$L(GMTSNN)

 . S GMTSC=GMTSC+1 D:GMTSC=1 HDR

 . S GMTSCT=GMTSCT+1 D:GMTSCT>22 CONT S:GMTSCT>22 GMTSCT=0

 . S GMTSON=$E(GMTSON,1,31)_"   " F  Q:$L(GMTSON)>30  S GMTSON=GMTSON_"."

 . S GMTSTR=$J(GMTSC,5)_"   "_GMTSON W !,GMTSTR W ?42,$E(GMTSNN,1,36)

 S DIR(0)="YAO",DIR("A")="Is this Correct:  (Y/N)  ",DIR("B")="Y" W ! D ^DIR I +($G(Y))'>0 W !,"Selection items not resequenced" Q

VER2 ; Verified

 K ^GMT(142,GMTSI2,1,GMTSI1,1)

 S (GMTSI,GMTSC)=0 F  S GMTSI=$O(OPA(GMTSI)) Q:+GMTSI=0  D

 . S GMTSVAL=$G(OPA(GMTSI)) Q:'$L(GMTSVAL)  S GMTSC=GMTSC+1

 . S ^GMT(142,GMTSI2,1,GMTSI1,1,GMTSC,0)=GMTSVAL

 N DIK,DA S DA=GMTSI2,DIK="^GMT(142," D IX1^DIK

 S ^GMT(142,GMTSI2,1,GMTSI1,1,0)="^142.14VA^"_GMTSC_"^"_GMTSC

 Q

 ;          

CONT ; Continue

 N DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="EA",DIR("A")=" Press <return> to continue.  " W ! D ^DIR

 S GMTSI=+($G(GMTSI)) D:+($O(INA(GMTSI)))>0 HDR

 Q

HDR ; Header

 W !!,?8,"Old Sequence",?42,"New Sequence",!,?8,"------------------------",?42,"------------------------" S GMTSCT=3

 Q

LKT ; Lookup HS Type

 N DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSERR

 W !,"Resequence the Selection Items of a Health Summary Type.",!

 ;

LKT2 ;   Re-prompt

 S GMTSERR=0,DIC="^GMT(142,",DIC("S")="I +($$ST^GMTSRS2)>0",DIC(0)="AEMQZF"

 S DIC("A")="Select a Health Summary Type:  "

 D ^DIC I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S Y=-1 Q

 I +($G(GMTSERR))>0 D DTE(+($G(GMTSERR))) G LKT2

 I +Y>0 D

 . N X,DIC S X=$P(Y,"^",2),DIC="^GMT(142,",DIC(0)="M" D ^DIC

 Q

 ;          

ST(X) ;   Screen for Type

 N GMTSY,GMTSO,GMTSS,GMTSU,GMTSKEY,GMTSLOCK,GMTSN0,GMTSMGR

 S GMTSO=0,GMTSY=+($G(Y)) S:+GMTSY'>0 GMTSERR=1 Q:+GMTSY'>0 1

 S GMTSN0=$G(^GMT(142,+GMTSY,0)) S:'$L(GMTSN0) GMTSERR=2 Q:'$L(GMTSN0) 1

 S GMTSKEY=$P(GMTSN0,"^",2),GMTSU=$P(GMTSN0,"^",3)

 S GMTSMGR=$S($D(^XUSEC("GMTSMGR",+($G(DUZ)))):1,1:0) S GMTSLOCK=0

 S:$L(GMTSKEY) GMTSLOCK=$S($D(^XUSEC(GMTSKEY,+($G(DUZ)))):0,1:1)

 S:$P(GMTSN0,"^",1)="GMTS HS ADHOC OPTION" GMTSERR=3 Q:$P(GMTSN0,"^",1)="GMTS HS ADHOC OPTION" 1

 S:+($G(^GMT(142,+GMTSY,"VA")))>0 GMTSERR=6 Q:+($G(^GMT(142,+GMTSY,"VA")))>0 1

 S (GMTSO,GMTSS)=0 F  S GMTSS=$O(^GMT(142,+GMTSY,1,GMTSS)) Q:+GMTSS=0  D  Q:GMTSO>1

 . Q:'$D(^GMT(142,+GMTSY,1,GMTSS,1,"B"))  N GMTSI S GMTSI=0

 . F  S GMTSI=$O(^GMT(142,+GMTSY,1,GMTSS,1,GMTSI)) Q:+GMTSI=0  D  Q:+GMTSO>1

 . . S GMTSO=+($G(GMTSO))+1

 S X=GMTSO S:+X'>0 GMTSERR=7 S:+X=1 GMTSERR=8

 Q 1

DTE(X) ;   Display Type Error

 I +($G(X))=1 W !!,"     No Health Summary Type selected.",! Q

 I +($G(X))=2 W !!,"     Health Summary Type not found.",! Q

 I +($G(X))=3 W !!,"     Can not resequence AD HOC Health Summary Type.",! Q

 I +($G(X))=4 W !!,"     Health Summary Type LOCKED",! Q

 I +($G(X))=5 W !!,"     Can not resequence a Health Summary Type you do not own.",! Q

 I +($G(X))=6 W !!,"     Can not resequence a Nationally exported Health Summary Type.",! Q

 I +($G(X))=7 W !!,"     Health Summary Type does not have selection items." D FMT Q

 I +($G(X))=8 W !!,"     Can not resequence, selected Health Summary Type only has",!,"     one (1) selection item.",! Q

 Q

FMT ;   Format of Type

 W !!,"       <Health Summary Type>"

 W !,"         <Health Summary Commponent>  i.e., 'PCE HEALTH FACTORS SELECTED'"

 W !,"           <Selection Items> i.e., TOBACCO USE",!

 Q

LKS ; Lookup HS Component Structure

 Q:+($G(GMTST))'>0

 N DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSERR,DA

LKS2 ;   Re-prompt for Component

 S GMTSERR=0,DA(1)=+($G(GMTST)),DIC="^GMT(142,"_DA(1)_",1,"

 S DIC("S")="I +($$SS^GMTSRS2)>0",DIC(0)="AEMQZF"

 S DIC("A")="Select a Health Summary Component:  "

 D ^DIC I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S Y=-1 Q

 I +($G(GMTSERR))>0 D DCE(+($G(GMTSERR))) G LKS2

 I +Y>0 D

 . N X,DIC S X=$P(Y,"^",2),DIC="^GMT(142,"_DA(1)_",1,",DIC(0)="M" D ^DIC

 Q

SS(X) ;   Screen for Structure

 S GMTST=+($G(GMTST)) Q:+GMTST'>0 0

 N GMTSY,GMTSI,GMTSO,GMTSS,GMTSU,GMTSKEY,GMTSLOCK,GMTSN0,GMTSMGR

 S GMTSO=0,GMTSY=+($G(Y)) S:+GMTSY'>0 GMTSERR=1 Q:+GMTSY'>0 1

 S GMTSN0=$G(^GMT(142,+GMTST,1,+GMTSY,0)) S:'$L(GMTSN0) GMTSERR=2 Q:'$L(GMTSN0) 1

 S:'$D(^GMT(142,GMTST,1,+GMTSY,1,"B")) GMTSERR=3 Q:'$D(^GMT(142,GMTST,1,+GMTSY,1,"B"))

 S (GMTSO,GMTSI)=0

 F  S GMTSI=$O(^GMT(142,GMTST,1,+GMTSY,1,GMTSI)) Q:+GMTSI=0  D  Q:+GMTSO>1

 . S GMTSO=+($G(GMTSO))+1

 S X=GMTSO S:+X'>0 GMTSERR=3 S:+X=1 GMTSERR=4

 Q 1

DCE(X) ;   Display Component Error

 I +($G(X))=1 W !!,"     No Health Summary Component selected.",! Q

 I +($G(X))=2 W !!,"     Health Summary Component not found.",! Q

 I +($G(X))=3 W !!,"     Health Summary Component does not have selection items." D FMT Q

 I +($G(X))=4 W !!,"     Can not resequence, selected Health Summary Component ",!,"     only has one (1) selection item.",! Q

 Q 1

GMTSRS2   ; SLC/KER - Selection Items Resequence      ; 02/11/2003 [6/13/03 10:30am]

 +1       ;;2.7;Health Summary;**62**;Oct 20, 1995

 +2       ;

 +3       ; External References

 +4       ;   DBIA 10076  ^XUSEC(

 +5       ;   DBIA 10076  ^XUSEC("GMTSMGR"

 +6       ;   DBIA 10026  ^DIR

 +7       ;   DBIA 10006  ^DIC  (file #142)

 +8       ;   DBIA  2054  $$CREF^DILF

 +9       ;   DBIA 10013  IX1^DIK

 +10      ;          

 +11      ; This routine will resequence the selection items (sub-file 

 +12      ; 142.14) of a Health Component in the structure (sub-file 

 +13      ; 142.01) of a Health Summary Type (file 142)

 +14      ;          

EN        ; Main Entry Point

 +1        NEW DA,GMTST,GMTSS,GMTSERR,X,Y

           DO LKT

           IF +Y'>0

               QUIT 

           SET GMTST=+Y

           DO LKS

           IF +Y'>0

               QUIT 

           SET GMTSS=+Y

 +2        SET DA(2)=GMTST

           SET DA(1)=GMTSS

           DO RSI

 +3        QUIT 

RSI       ; Resequence Selection Items

 +1        NEW ARY,INA,OPA,X,Y,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSO,GMTS1

 +2        NEW GMTSAC,GMTSAI,GMTSC,GMTSCHG,GMTSCOL,GMTSERR,GMTSF,GMTSHDR,GMTSI

 +3        NEW GMTSI1,GMTSI2,GMTSIN,GMTSINM,GMTSKEY,GMTSLOCK,GMTSMAX

 +4        NEW GMTSMGR,GMTSO,GMTSON,GMTSOP,GMTSPIE,GMTSRO,GMTSROOT,GMTSS

 +5        NEW GMTST,GMTSU,GMTSVAL,GMTSY

           WRITE !

           KILL ARY,INA,OPA

 +6        DO INA^GMTSRS2B(DA(2),DA(1),.ARY)

 +7        SET GMTSINM=$$MAX(.ARY)

 +8        IF +GMTSINM'>0

               Begin DoDot:1

 +9                IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))

                       WRITE !,"Can not resequence, no selection items found."

               End DoDot:1

               QUIT 

 +10       IF +GMTSINM'>1

               IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))

                   WRITE !,"Resequencing not required (1 item)"

 +11       FOR 

               DO RESEQ(.ARY)

               IF '$DATA(ARY)

                   QUIT 

 +12       SET GMTSMAX=$$MAX(.OPA)

 +13       IF +GMTSINM'=+GMTSMAX

               IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))

                   WRITE !,"Selection items not resequenced (sequence not fully specified)"

                   QUIT 

 +14       IF +GMTSMAX>0

               DO VER(.INA,.OPA,DA(2),DA(1))

 +15       QUIT 

 +16      ;          

RESEQ(ARY) ; Resequence - .ARY

 +1        NEW GMTSNXT,GMTSI,GMTSIN,GMTSOP,GMTS0,GMTS1,GMTSAC,GMTSAI,GMTSMAX

           SET GMTSMAX=$$MAX(.ARY)

 +2        SET (GMTSAI,GMTSAC)=0

           FOR 

               SET GMTSAI=$ORDER(ARY(GMTSAI))

               IF +GMTSAI=0

                   QUIT 

               SET GMTSAC=+($GET(GMTSAC))+1

 +3        DO RES^GMTSRS2B(.ARY)

           SET (GMTSAI,GMTSAC)=0

           FOR 

               SET GMTSAI=$ORDER(ARY(GMTSAI))

               IF +GMTSAI=0

                   QUIT 

               SET GMTSAC=+($GET(GMTSAC))+1

 +4        IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))&(GMTSMAX>72)

               WRITE !,"Resequence selection items:",!

 +5        IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))&(GMTSMAX>72)

               DO DIS^GMTSRS2B(.ARY)

 +6        IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))&(GMTSMAX'>72)

               Begin DoDot:1

 +7                NEW GMTSROOT,GMTSNODE,GMTSPIE,GMTSHDR,GMTSCOL

                   SET ARY(0)=$GET(GMTSMAX)

 +8                SET GMTSROOT="ARY"

                   SET GMTSHDR="Resequence selection items:"

                   SET GMTSNODE=1

                   SET GMTSPIE=2

 +9                SET GMTSCOL=1

                   IF +GMTSMAX>18

                       SET GMTSCOL=2

                   IF +GMTSMAX>36

                       SET GMTSCOL=3

                   IF +GMTSMAX>54

                       SET GMTSCOL=4

                   IF +GMTSMAX>72

                       SET GMTSCOL=5

                   IF +GMTSMAX>90

                       SET GMTSCOL=6

 +10               DO EN^GMTSRS4(GMTSROOT,GMTSNODE,GMTSPIE,GMTSHDR,GMTSCOL)

               End DoDot:1

 +11       SET GMTSNXT=$$ASK(.ARY,.GMTSNXT)

           FOR 

               IF $EXTRACT(GMTSNXT,$LENGTH(GMTSNXT))'=","

                   QUIT 

               SET GMTSNXT=$EXTRACT(GMTSNXT,1,($LENGTH(GMTSNXT)-1))

 +12       IF +GMTSNXT'>0

               KILL ARY

           IF +GMTSNXT'>0

               QUIT 

 +13       SET GMTSI=0

           FOR GMTSI=1:1

               IF +($PIECE(GMTSNXT,",",GMTSI))'>0

                   QUIT 

               Begin DoDot:1

 +14               NEW GMTSIN,GMTSOP,GMTS0,GMTS1

                   SET GMTSIN=+($PIECE(GMTSNXT,",",GMTSI))

 +15               SET GMTS0=$GET(ARY(GMTSIN))

                   SET GMTS1=$GET(ARY(GMTSIN,1))

 +16               KILL ARY(GMTSIN)

                   IF '$LENGTH(GMTS0)

                       QUIT 

                   IF '$LENGTH(GMTS1)

                       QUIT 

 +17               SET GMTSOP=+($ORDER(OPA(" "),-1))+1

                   SET OPA(GMTSOP)=GMTS0

 +18               SET OPA(GMTSOP,1)=GMTS1

                   KILL ARY(GMTSIN)

               End DoDot:1

 +19       SET GMTSA1=1

 +20       FOR 

               SET GMTSNXT=$GET(GMTSNXT(GMTSA1))

               IF +$GET(GMTSNXT)=0

                   QUIT 

               Begin DoDot:1

 +21               SET GMTSI=0

                   FOR GMTSI=1:1

                       IF +($PIECE(GMTSNXT,",",GMTSI))'>0

                           QUIT 

                       Begin DoDot:2

 +22                       NEW GMTSIN,GMTSOP,GMTS0,GMTS1

                           SET GMTSIN=+($PIECE(GMTSNXT,",",GMTSI))

 +23                       SET GMTS0=$GET(ARY(GMTSIN))

                           SET GMTS1=$GET(ARY(GMTSIN,1))

 +24                       KILL ARY(GMTSIN)

                           IF '$LENGTH(GMTS0)

                               QUIT 

                           IF '$LENGTH(GMTS1)

                               QUIT 

 +25                       SET GMTSOP=+($ORDER(OPA(" "),-1))+1

                           SET OPA(GMTSOP)=GMTS0

 +26                       SET OPA(GMTSOP,1)=GMTS1

                           KILL ARY(GMTSIN)

                       End DoDot:2

 +27               SET GMTSA1=GMTSA1+1

               End DoDot:1

 +28       QUIT 

 +29      ;          

ASK(ARY,NEXT,X) ; Ask for order of Selection Items

 +1        NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSMAX,Y,GMTSF,GMTSI

           SET GMTSMAX=$$MAX(.ARY)

           IF +GMTSMAX=1

               QUIT 1

           IF +GMTSMAX'>0

               QUIT ""

 +2        FOR GMTSI=1:1:GMTSMAX

               SET GMTSF=$GET(GMTSF)_GMTSI_","

 +3        IF $DATA(GMTSRO)

               IF +GMTSRO=0

                   SET X=GMTSF

                   QUIT X

 +4        SET DIR(0)="LAO^1:"_GMTSMAX_":0"

           SET DIR("A")="Select next item(s)"

           IF GMTSMAX>1

               SET DIR("A")=DIR("A")_" 1-"_GMTSMAX

 +5        SET DIR("?",1)="Specify a set of Selection Items: eg 2-9,1,10-15"

 +6        SET DIR("?",2)="          You must use every Selection Item in the set"

 +7        SET DIR("?",3)="          For example, if there are 20 Selection Items"

 +8        SET DIR("?",4)="            every number from 1 to 20 must be included"

 +9        SET DIR("?")="            in the resulting set. eg 10-20,5-9,1-4"

 +10       SET DIR("A")=DIR("A")_":  "

           SET DIR("B")=1

           WRITE !

           DO ^DIR

 +11       IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               KILL ARY

               SET X=-1

               QUIT X

 +12       MERGE NEXT=Y

 +13       SET X=Y

           QUIT X

 +14      ;

MAX(ARY,X) ; Maximum # Items

 +1        NEW GMTSI

           SET (GMTSI,X)=0

           FOR 

               SET GMTSI=$ORDER(ARY(GMTSI))

               IF +GMTSI=0

                   QUIT 

               SET X=X+1

 +2        SET ARY(0)=X

           QUIT X

 +3       ;          

VER(INA,OPA,GMTST,GMTSS) ; Verify Resequence

 +1        NEW GMTSI2,GMTSI1,GMTSI,GMTSC,GMTSON,GMTSNN,GMTSCHG,GMTSVAL,GMTSTR,GMTSCT,X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT

 +2        SET GMTSI2=+($GET(GMTST))

           IF +GMTSI2=0

               QUIT 

           SET GMTSI1=+($GET(GMTSS))

           IF +GMTSI1=0

               QUIT 

 +3        IF $DATA(GMTSRO)

               IF +GMTSRO=0

                   GOTO VER2

 +4        SET (GMTSI,GMTSC,GMTSCHG)=0

           FOR 

               SET GMTSI=$ORDER(INA(GMTSI))

               IF +GMTSI=0

                   QUIT 

               Begin DoDot:1

 +5                SET GMTSON=$PIECE($GET(INA(GMTSI,1)),"^",2)

 +6                SET GMTSNN=$PIECE($GET(OPA(GMTSI,1)),"^",2)

                   IF GMTSON'=GMTSNN

                       SET GMTSCHG=1

               End DoDot:1

 +7        IF 'GMTSCHG

               IF '$DATA(GMTSRO)!($DATA(GMTSRO)&(+($GET(GMTSRO))>0))

                   WRITE !,"No changes in the Selection Item sequence."

                   SET GMTSRO=0

                   GOTO VER2

 +8        SET GMTSCT=0

           FOR 

               SET GMTSI=$ORDER(INA(GMTSI))

               IF +GMTSI=0

                   QUIT 

               Begin DoDot:1

 +9                SET GMTSON=$PIECE($GET(INA(GMTSI,1)),"^",2)

                   SET GMTSNN=$PIECE($GET(OPA(GMTSI,1)),"^",2)

                   IF '$LENGTH(GMTSON)

                       QUIT 

                   IF '$LENGTH(GMTSNN)

                       QUIT 

 +10               SET GMTSC=GMTSC+1

                   IF GMTSC=1

                       DO HDR

 +11               SET GMTSCT=GMTSCT+1

                   IF GMTSCT>22

                       DO CONT

                   IF GMTSCT>22

                       SET GMTSCT=0

 +12               SET GMTSON=$EXTRACT(GMTSON,1,31)_"   "

                   FOR 

                       IF $LENGTH(GMTSON)>30

                           QUIT 

                       SET GMTSON=GMTSON_"."

 +13               SET GMTSTR=$JUSTIFY(GMTSC,5)_"   "_GMTSON

                   WRITE !,GMTSTR

                   WRITE ?42,$EXTRACT(GMTSNN,1,36)

               End DoDot:1

 +14       SET DIR(0)="YAO"

           SET DIR("A")="Is this Correct:  (Y/N)  "

           SET DIR("B")="Y"

           WRITE !

           DO ^DIR

           IF +($GET(Y))'>0

               WRITE !,"Selection items not resequenced"

               QUIT 

VER2      ; Verified

 +1        KILL ^GMT(142,GMTSI2,1,GMTSI1,1)

 +2        SET (GMTSI,GMTSC)=0

           FOR 

               SET GMTSI=$ORDER(OPA(GMTSI))

               IF +GMTSI=0

                   QUIT 

               Begin DoDot:1

 +3                SET GMTSVAL=$GET(OPA(GMTSI))

                   IF '$LENGTH(GMTSVAL)

                       QUIT 

                   SET GMTSC=GMTSC+1

 +4                SET ^GMT(142,GMTSI2,1,GMTSI1,1,GMTSC,0)=GMTSVAL

               End DoDot:1

 +5        NEW DIK,DA

           SET DA=GMTSI2

           SET DIK="^GMT(142,"

           DO IX1^DIK

 +6        SET ^GMT(142,GMTSI2,1,GMTSI1,1,0)="^142.14VA^"_GMTSC_"^"_GMTSC

 +7        QUIT 

 +8       ;          

CONT      ; Continue

 +1        NEW DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT

 +2        SET DIR(0)="EA"

           SET DIR("A")=" Press <return> to continue.  "

           WRITE !

           DO ^DIR

 +3        SET GMTSI=+($GET(GMTSI))

           IF +($ORDER(INA(GMTSI)))>0

               DO HDR

 +4        QUIT 

HDR       ; Header

 +1        WRITE !!,?8,"Old Sequence",?42,"New Sequence",!,?8,"------------------------",?42,"------------------------"

           SET GMTSCT=3

 +2        QUIT 

LKT       ; Lookup HS Type

 +1        NEW DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSERR

 +2        WRITE !,"Resequence the Selection Items of a Health Summary Type.",!

 +3       ;

LKT2      ;   Re-prompt

 +1        SET GMTSERR=0

           SET DIC="^GMT(142,"

           SET DIC("S")="I +($$ST^GMTSRS2)>0"

           SET DIC(0)="AEMQZF"

 +2        SET DIC("A")="Select a Health Summary Type:  "

 +3        DO ^DIC

           IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))

               SET Y=-1

               QUIT 

 +4        IF +($GET(GMTSERR))>0

               DO DTE(+($GET(GMTSERR)))

               GOTO LKT2

 +5        IF +Y>0

               Begin DoDot:1

 +6                NEW X,DIC

                   SET X=$PIECE(Y,"^",2)

                   SET DIC="^GMT(142,"

                   SET DIC(0)="M"

                   DO ^DIC

               End DoDot:1

 +7        QUIT 

 +8       ;          

ST(X)     ;   Screen for Type

 +1        NEW GMTSY,GMTSO,GMTSS,GMTSU,GMTSKEY,GMTSLOCK,GMTSN0,GMTSMGR

 +2        SET GMTSO=0

           SET GMTSY=+($GET(Y))

           IF +GMTSY'>0

               SET GMTSERR=1

           IF +GMTSY'>0

               QUIT 1

 +3        SET GMTSN0=$GET(^GMT(142,+GMTSY,0))

           IF '$LENGTH(GMTSN0)

               SET GMTSERR=2

           IF '$LENGTH(GMTSN0)

               QUIT 1

 +4        SET GMTSKEY=$PIECE(GMTSN0,"^",2)

           SET GMTSU=$PIECE(GMTSN0,"^",3)

 +5        SET GMTSMGR=$SELECT($DATA(^XUSEC("GMTSMGR",+($GET(DUZ)))):1,1:0)

           SET GMTSLOCK=0

 +6        IF $LENGTH(GMTSKEY)

               SET GMTSLOCK=$SELECT($DATA(^XUSEC(GMTSKEY,+($GET(DUZ)))):0,1:1)

 +7        IF $PIECE(GMTSN0,"^",1)="GMTS HS ADHOC OPTION"

               SET GMTSERR=3

           IF $PIECE(GMTSN0,"^",1)="GMTS HS ADHOC OPTION"

               QUIT 1

 +8        IF +($GET(^GMT(142,+GMTSY,"VA")))>0

               SET GMTSERR=6

           IF +($GET(^GMT(142,+GMTSY,"VA")))>0

               QUIT 1

 +9        SET (GMTSO,GMTSS)=0

           FOR 

               SET GMTSS=$ORDER(^GMT(142,+GMTSY,1,GMTSS))

               IF +GMTSS=0

                   QUIT 

               Begin DoDot:1

 +10               IF '$DATA(^GMT(142,+GMTSY,1,GMTSS,1,"B"))

                       QUIT 

                   NEW GMTSI

                   SET GMTSI=0

 +11               FOR 

                       SET GMTSI=$ORDER(^GMT(142,+GMTSY,1,GMTSS,1,GMTSI))

                       IF +GMTSI=0

                           QUIT 

                       Begin DoDot:2

 +12                       SET GMTSO=+($GET(GMTSO))+1

                       End DoDot:2

                       IF +GMTSO>1

                           QUIT 

               End DoDot:1

               IF GMTSO>1

                   QUIT 

 +13       SET X=GMTSO

           IF +X'>0

               SET GMTSERR=7

           IF +X=1

               SET GMTSERR=8

 +14       QUIT 1

DTE(X)    ;   Display Type Error

 +1        IF +($GET(X))=1

               WRITE !!,"     No Health Summary Type selected.",!

               QUIT 

 +2        IF +($GET(X))=2

               WRITE !!,"     Health Summary Type not found.",!

               QUIT 

 +3        IF +($GET(X))=3

               WRITE !!,"     Can not resequence AD HOC Health Summary Type.",!