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