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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRS2 9797 printed Dec 13, 2024@02:00:20 Page 2
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.",!
QUIT
+4 IF +($GET(X))=4
WRITE !!," Health Summary Type LOCKED",!
QUIT
+5 IF +($GET(X))=5
WRITE !!," Can not resequence a Health Summary Type you do not own.",!
QUIT
+6 IF +($GET(X))=6
WRITE !!," Can not resequence a Nationally exported Health Summary Type.",!
QUIT
+7 IF +($GET(X))=7
WRITE !!," Health Summary Type does not have selection items."
DO FMT
QUIT
+8 IF +($GET(X))=8
WRITE !!," Can not resequence, selected Health Summary Type only has",!," one (1) selection item.",!
QUIT
+9 QUIT
FMT ; Format of Type
+1 WRITE !!," <Health Summary Type>"
+2 WRITE !," <Health Summary Commponent> i.e., 'PCE HEALTH FACTORS SELECTED'"
+3 WRITE !," <Selection Items> i.e., TOBACCO USE",!
+4 QUIT
LKS ; Lookup HS Component Structure
+1 if +($GET(GMTST))'>0
QUIT
+2 NEW DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSERR,DA
LKS2 ; Re-prompt for Component
+1 SET GMTSERR=0
SET DA(1)=+($GET(GMTST))
SET DIC="^GMT(142,"_DA(1)_",1,"
+2 SET DIC("S")="I +($$SS^GMTSRS2)>0"
SET DIC(0)="AEMQZF"
+3 SET DIC("A")="Select a Health Summary Component: "
+4 DO ^DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))!($DATA(DIROUT))
SET Y=-1
QUIT
+5 IF +($GET(GMTSERR))>0
DO DCE(+($GET(GMTSERR)))
GOTO LKS2
+6 IF +Y>0
Begin DoDot:1
+7 NEW X,DIC
SET X=$PIECE(Y,"^",2)
SET DIC="^GMT(142,"_DA(1)_",1,"
SET DIC(0)="M"
DO ^DIC
End DoDot:1
+8 QUIT
SS(X) ; Screen for Structure
+1 SET GMTST=+($GET(GMTST))
if +GMTST'>0
QUIT 0
+2 NEW GMTSY,GMTSI,GMTSO,GMTSS,GMTSU,GMTSKEY,GMTSLOCK,GMTSN0,GMTSMGR
+3 SET GMTSO=0
SET GMTSY=+($GET(Y))
if +GMTSY'>0
SET GMTSERR=1
if +GMTSY'>0
QUIT 1
+4 SET GMTSN0=$GET(^GMT(142,+GMTST,1,+GMTSY,0))
if '$LENGTH(GMTSN0)
SET GMTSERR=2
if '$LENGTH(GMTSN0)
QUIT 1
+5 if '$DATA(^GMT(142,GMTST,1,+GMTSY,1,"B"))
SET GMTSERR=3
if '$DATA(^GMT(142,GMTST,1,+GMTSY,1,"B"))
QUIT
+6 SET (GMTSO,GMTSI)=0
+7 FOR
SET GMTSI=$ORDER(^GMT(142,GMTST,1,+GMTSY,1,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+8 SET GMTSO=+($GET(GMTSO))+1
End DoDot:1
if +GMTSO>1
QUIT
+9 SET X=GMTSO
if +X'>0
SET GMTSERR=3
if +X=1
SET GMTSERR=4
+10 QUIT 1
DCE(X) ; Display Component Error
+1 IF +($GET(X))=1
WRITE !!," No Health Summary Component selected.",!
QUIT
+2 IF +($GET(X))=2
WRITE !!," Health Summary Component not found.",!
QUIT
+3 IF +($GET(X))=3
WRITE !!," Health Summary Component does not have selection items."
DO FMT
QUIT
+4 IF +($GET(X))=4
WRITE !!," Can not resequence, selected Health Summary Component ",!," only has one (1) selection item.",!
QUIT
+5 QUIT 1
