GMTSXAR ; SLC/KER - List Parameters/Resequence ; 02/27/2002
;;2.7;Health Summary;**49,62**;Oct 20, 1995
;
; External References
; DBIA 10022 %XY^%RCR
; DBIA 10018 ^DIE (file #8989.51)
; DBIA 10006 ^DIC (file #8989.51, 8989.518)
; DBIA 10026 ^DIR
; DBIA 2056 $$GET1^DIQ (file #8989.513)
; DBIA 2052 FIELD^DID (file #8989.51)
; DBIA 2992 ^XTV(8989.51,
;
Q
EN ; Main Entry
N X,%X,Y,%Y,DA,DIC,DIDEL,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,GMTSA,GMTSC,GMTSCHG,GMTSCNT,GMTSCONT,GMTSCT,GMTSCUR,GMTSD,GMTSEQ,GMTSEXIT
N GMTSF,GMTSFI,GMTSI,GMTSIE,GMTSM,GMTSMAX,GMTSN,GMTSNEW,GMTSNXC,GMTSNXT,GMTSO,GMTSOK,GMTSOLD,GMTSON,GMTSORD,GMTSPARM,GMTSPI,GMTSREM
N GMTSREO,GMTSSSO,GMTST,GMTSTOT,GMTSUSR,GMTSMGR
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
S GMTSCHG=0,GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
S %X="^XTV(8989.51,"_GMTSPI_",30,",%Y="GMTSO(""AL""," D %XY^%RCR S %X="^XTV(8989.518,",%Y="GMTSO(""ET""," D %XY^%RCR K GMTSO("ET","B"),GMTSO("ET","C")
S (GMTSI,GMTSC)=0 F S GMTSI=$O(GMTSO("AL","B",GMTSI)) Q:+GMTSI=0 D
. N GMTSIE S GMTSEQ(GMTSI)="",GMTSIE=0
. F S GMTSIE=$O(GMTSO("AL","B",GMTSI,GMTSIE)) Q:+GMTSIE=0 D
. . N GMTSF S GMTSF=$P($G(GMTSO("AL",GMTSIE,0)),"^",2) Q:+GMTSF=0 Q:'$D(GMTSO("ET",GMTSF,0))
. . S GMTSC=GMTSC+1
. . S (GMTSCUR(GMTSC),GMTSOLD(GMTSC))=GMTSI_"^"_GMTSF_"^"_$G(GMTSO("ET",GMTSF,0))
. . S GMTSOLD("B",GMTSI,GMTSC)=""
D ORD D:+($G(GMTSEXIT))=0 CHK
W:+($G(GMTSCHG))'>0 !!,?2,"No Changes Made"
Q
ORD ; Order of Entities
N GMTSI,GMTST,GMTSC,GMTSCNT,GMTSTOT,GMTSREM,GMTSSO,GMTSNXT,GMTSNXC,GMTSON
S (GMTSSO,GMTSCNT,GMTSI,GMTSON)=0,(GMTSTOT,GMTST)=$$TOT Q:+GMTSTOT'>1
S GMTSEXIT=0,GMTSCONT=$$CONT I +GMTSCONT>0 S GMTSEXIT=1 Q
W !!," Please select the order in which you want these to be entities"
W !," to be used." F Q:+($G(GMTSEXIT))>0 D SO Q:+($G(GMTSEXIT))>0 Q:'$D(GMTSOLD)
S GMTSEXIT=0
Q
;
SO ; Select Order
K GMTSOLD("B") N GMTSI,GMTSC,GMTSMAX,GMTSREO S GMTSI=0,GMTSREM=$$TOT
S GMTSCNT=GMTSTOT-GMTSREM,GMTSNXT=GMTSCNT+1,GMTSSO=+($G(GMTSSO))+1
S GMTSNXC=$S(GMTSNXT=1:(GMTSNXT_"st"),GMTSNXT=2:(GMTSNXT_"nd"),GMTSNXT=3:(GMTSNXT_"rd"),1:(GMTSNXT_"th"))
I +GMTSREM=1 S Y=+GMTSREM D SET Q
W ! D SOL,REO S (GMTSC,GMTSI)=0
S GMTSMAX=GMTSREM W ! N DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
S DIR(0)="NAO^1:"_GMTSMAX_":0",DIR("?")="^D SOH1^GMTSXAR",DIR("??")="^D SOH2^GMTSXAR"
S DIR("A")=" Select the "_GMTSNXC_" entity to be used: "
K DIR("B") S:+($O(GMTSREO(0)))>0 DIR("B")=+($O(GMTSREO(0)))
D ^DIR I Y="",X="@" D
. N GMTSD S GMTSD=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
. S GMTSEXIT="1^"_$S($L(GMTSD):"",1:"exiting")
. S Y="@" K GMTSORD S GMTSORD("@")=""
S:Y["^"!($D(DUOUT))!($D(DIROUT)) GMTSEXIT="1^exiting" S:$D(DTOUT) GMTSEXIT="1^try later"
I +($G(GMTSEXIT))>0 W $S($L($P(GMTSEXIT,"^",2)):"...",1:""),$P(GMTSEXIT,"^",2) Q
I +Y>0,+Y'>GMTSREM D SET
Q
SOL ; List
N GMTSN,GMTSA,GMTST,GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
. S GMTSC=GMTSC+1,GMTSA=$P(GMTSOLD(GMTSI),"^",4),GMTSN=$P(GMTSOLD(GMTSI),"^",5)
. S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
. W !,?5,$J(GMTSC,4)," ",GMTST
Q
SOH1 ; Help - Single ?
N GMTSC,GMTSI,GMTSN,GMTSCT S (GMTSC,GMTSI)=0,GMTSCT=+($G(GMTSNXT)) F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 S GMTSC=GMTSC+1
S GMTSN=$S(GMTSCT=1:"first",GMTSCT=2:"second",GMTSCT=3:"third",GMTSCT=4:"fourth",GMTSCT=5:"fifty",GMTSCT=6:"sixth",GMTSCT=7:"seventh",GMTSCT=8:"eighth",GMTSCT=9:"nineth",GMTSCT=10:"tenth",GMTSCT=11:"eleventh",1:"")
I '$L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list" W:$L($G(GMTSNXC)) " ",GMTSNXC W " (1-",GMTSC,")",!
I $L(GMTSN),+GMTSC>1 W !,?11,"Select a Health Summary Type entity to list ",GMTSN," (1-",GMTSC,")",!
D SOL
Q
SOH2 ; Help - Double ??
I '$L($G(GMTSPARM)) D SOH1 Q
W !,?11,"Parameter """,GMTSPARM,""" has multiple "
W !,?11,"allowable entities for which Health Summary Types may"
W !,?11,"be assigned and displayed on the CPRS reports tab. Now"
W !,?11,"you must select the order in which you want these entites"
W !,?11,"to be used by the site.",!
D SOL
Q
;
; Arrange
SET ; Set Order
D REO N GMTSO S GMTSO=+($O(GMTSORD(" "),-1))+1
I $L($P($G(GMTSREO(+($G(Y)))),"^",2,299)) D
. S GMTSON=$O(GMTSEQ(GMTSON))
. S GMTSORD(GMTSO)=GMTSON_"^"_$P($G(GMTSREO(+Y)),"^",2,299)
S (GMTSC,GMTSI)=0
F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
. S GMTSC=GMTSC+1 I GMTSC=+Y K GMTSOLD(GMTSI),GMTSREO(GMTSC)
Q
REO ; Re-order
K GMTSREO N GMTSC,GMTSI S (GMTSC,GMTSI)=0
F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 D
. S GMTSC=GMTSC+1 S GMTSREO(GMTSC)=$G(GMTSOLD(GMTSI))
Q
TOT(X) ; Total Allowable Entities
N GMTSI S (X,GMTSI)=0 F S GMTSI=$O(GMTSOLD(GMTSI)) Q:+GMTSI=0 S X=X+1
Q X
CONT(X) ; Ask to Continue
S:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) GMTSEXIT=1
Q:$O(GMTSCUR(0))=0!('$L($G(GMTSPARM)))!(+($G(GMTSTOT))'>1) 0
W !!!," Parameter """,GMTSPARM,""" has ",GMTSTOT," allowable entities"
W !," which may have the Health Summary Types on the CPRS reports tab "
W !," and are used in the following order:"
N DIR,DIROUT,DUOUT,DTOUT,GMTSA,GMTSN,GMTST,GMTSC,GMTSI D CONTM
S DIR("A")=" Are these in the correct order for your site? "
S (DIR("?"),DIR("??"))="^D CONTH^GMTSXAR",DIR("B")="Y",DIR(0)="YAO" W ! D ^DIR
S X=+($G(Y)) Q X
Q 1
CONTH ; Continue Help
W !," Enter either 'Y' or 'N'"
D CONTM Q
CONTM ; Continue Menu
S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
. S GMTSA=$P(GMTSCUR(GMTSI),"^",4),GMTSN=$P(GMTSCUR(GMTSI),"^",5)
. S GMTST=GMTSN_$S(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
. S GMTSC=GMTSC+1 W:GMTSC=1 ! W !,$J(GMTSC,6)," ",GMTST
Q
CHK ; Check if OK
N GMTSC,GMTSI,GMTSA S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 S:GMTSCUR(GMTSI)'[$G(GMTSORD(GMTSI)) GMTSC=1
I 'GMTSC S GMTSCHG=0 Q
W !!,?8,"You have selected to resequenced the Health Summary Type"
W !,?8,"entities in the following order:",!
D CHKM S GMTSA=$$OK D:+($G(GMTSA))>0 ED
Q
CHKM ; Check (Menu)
N GMTSC,GMTSI S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 S:GMTSCUR(GMTSI)'[$G(GMTSORD(GMTSI)) GMTSC=1
Q:'GMTSC S (GMTSC,GMTSI)=0 F S GMTSI=$O(GMTSCUR(GMTSI)) Q:+GMTSI=0 D
. S GMTSC=GMTSC+1 W:GMTSC=1 !,?13,"FROM (Current)",?33,"TO (Resequenced)",!,?13,"----------------",?33,"----------------"
. W !,?7,$J(GMTSC,4),?13,$P($G(GMTSCUR(GMTSI)),"^",5),?33,$P($G(GMTSORD(GMTSI)),"^",5)
Q
OK(X) ; Ask if OK
W ! N DIR,DIROUT,DUOUT,DTOUT S (DIR("?"),DIR("??"))="^D OKH^GMTSXAR"
S DIR("A")=" Is this OK? ",DIR("B")="Y",DIR(0)="YAO" D ^DIR S X=+($G(Y)) Q X
OKH ; OK Help
W !," Enter either 'Y' or 'N'",!,!," Resequence entities:",! D CHKM Q
;
ED ; Edit Record
N DIC,DA,DIE,DR,DIDEL,DTOUT,GMTSFI,GMTSI,GMTSEQ,GMTSCNT,GMTST
S GMTSPI=+($G(GMTSPI)),GMTSCNT=0
I GMTSPI'>0!(+($O(GMTSORD(0)))'>0)!('$L($G(GMTSPARM)))!($$PDN^GMTSXAW3(+GMTSPI)'=$G(GMTSPARM)) D Q
. W !,?5," Unable to resequence at this time."
S DA(1)=+($G(GMTSPI)) Q:DA(1)'>0 S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DR=".02///^S X=$G(GMTSFI)"
L ; Lock Record
L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
I 'GMTST,GMTSCNT'>3 H 2 G L
I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
S GMTSI=0 F S GMTSI=$O(GMTSORD(GMTSI)) Q:+GMTSI=0 D
. S GMTSFI=$P(GMTSORD(GMTSI),"^",2),GMTSEQ=$P(GMTSORD(GMTSI),"^",1)
. S DA=$$DA(DA(1),GMTSEQ),X=GMTSEQ D ^DIE S GMTSCHG=1
L -^XTV(8989.51,+($G(GMTSPI)))
Q
DA(GMTSI,X) ; Get DA
N DA,DIC,DTOUT,DUOUT,Y,GMTSM S DA(1)=+($G(GMTSI)),X=+($G(X))
S DIC="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="M" D ^DIC S X=+($G(Y)) Q X
Q
;
ADED ; Add/Edit
N X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,GMTSCNT,GMTSDEF,GMTSENT
N GMTSM,GMTSMGR,GMTSNEW,GMTSPARM,GMTSPI,GMTST
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
S GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0
W !! W:$L(GMTSPARM) "'" W GMTSPARM W:$L(GMTSPARM) "' " W "ALLOWABLE ENTITIES",!
S DA(1)=+($G(GMTSPI)),GMTSCNT=0
S (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,",DIC(0)="AEQMLZ"
S DIC("DR")=".02///^S X=$$AE^GMTSXAR(+($G(Y)))"
S DLAYGO="" D FIELD^DID(8989.51,30,"","SPECIFIER","GMTST(""DID"")","GMTSM(""ERR"")")
S:$L($G(GMTST("DID","SPECIFIER"))) DIC("P")=$G(GMTST("DID","SPECIFIER"))
L2 ; Lock Record
L +^XTV(8989.51,+($G(GMTSPI))) S GMTSCNT=GMTSCNT+1,GMTST=$T
I 'GMTST,GMTSCNT'>3 H 2 G L2
I 'GMTST,GMTSCNT>3 W !," Another user is editing this entry.",!," Unable to resequence at this time." Q
D ^DIC S GMTSNEW=+($P($G(Y),"^",3)) Q:GMTSNEW>0 Q:+Y'>0
N DIC,DIE S DA(1)=GMTSPI,DA=+($G(Y)),(DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
S DA=+($G(Y)),DR=".01;.02///^S X=$$AE^GMTSXAR("_DA_")"
D ^DIE L -^XTV(8989.51,+($G(GMTSPI)))
Q
AE(X) ; Allowable Entity
N DA,DIC,DTOUT,DUOUT,Y,GMTSPARM,GMTSPI,GMTSENT,GMTSDEF
S GMTSDEF="",GMTSENT=+($G(X)),GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
S GMTSPI=$$PDI^GMTSXAW3(GMTSPARM) Q:+GMTSPI=0 ""
S:+GMTSENT>0 GMTSDEF=$$GET1^DIQ(8989.513,(GMTSENT_","_GMTSPI_","),.02)
N DA,DIC,DTOUT,DUOUT,Y S DIC="^XTV(8989.518,",DIC(0)="AEMQ"
S DIC("S")="I Y'=3.5&(Y'=9.4)&(Y'=44)&(Y'=404.51)&(Y'=405.4)"
S:$L($G(GMTSDEF)) DIC("B")=GMTSDEF D ^DIC S X=+($G(Y))
Q X
GMTSXAR ; SLC/KER - List Parameters/Resequence ; 02/27/2002
+1 ;;2.7;Health Summary;**49,62**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10022 %XY^%RCR
+5 ; DBIA 10018 ^DIE (file #8989.51)
+6 ; DBIA 10006 ^DIC (file #8989.51, 8989.518)
+7 ; DBIA 10026 ^DIR
+8 ; DBIA 2056 $$GET1^DIQ (file #8989.513)
+9 ; DBIA 2052 FIELD^DID (file #8989.51)
+10 ; DBIA 2992 ^XTV(8989.51,
+11 ;
+12 QUIT
EN ; Main Entry
+1 NEW X,%X,Y,%Y,DA,DIC,DIDEL,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,GMTSA,GMTSC,GMTSCHG,GMTSCNT,GMTSCONT,GMTSCT,GMTSCUR,GMTSD,GMTSEQ,GMTSEXIT
+2 NEW GMTSF,GMTSFI,GMTSI,GMTSIE,GMTSM,GMTSMAX,GMTSN,GMTSNEW,GMTSNXC,GMTSNXT,GMTSO,GMTSOK,GMTSOLD,GMTSON,GMTSORD,GMTSPARM,GMTSPI,GMTSREM
+3 NEW GMTSREO,GMTSSSO,GMTST,GMTSTOT,GMTSUSR,GMTSMGR
+4 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+5 SET GMTSCHG=0
SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
+6 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
IF +GMTSPI=0
QUIT
+7 SET %X="^XTV(8989.51,"_GMTSPI_",30,"
SET %Y="GMTSO(""AL"","
DO %XY^%RCR
SET %X="^XTV(8989.518,"
SET %Y="GMTSO(""ET"","
DO %XY^%RCR
KILL GMTSO("ET","B"),GMTSO("ET","C")
+8 SET (GMTSI,GMTSC)=0
FOR
SET GMTSI=$ORDER(GMTSO("AL","B",GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+9 NEW GMTSIE
SET GMTSEQ(GMTSI)=""
SET GMTSIE=0
+10 FOR
SET GMTSIE=$ORDER(GMTSO("AL","B",GMTSI,GMTSIE))
IF +GMTSIE=0
QUIT
Begin DoDot:2
+11 NEW GMTSF
SET GMTSF=$PIECE($GET(GMTSO("AL",GMTSIE,0)),"^",2)
IF +GMTSF=0
QUIT
IF '$DATA(GMTSO("ET",GMTSF,0))
QUIT
+12 SET GMTSC=GMTSC+1
+13 SET (GMTSCUR(GMTSC),GMTSOLD(GMTSC))=GMTSI_"^"_GMTSF_"^"_$GET(GMTSO("ET",GMTSF,0))
+14 SET GMTSOLD("B",GMTSI,GMTSC)=""
End DoDot:2
End DoDot:1
+15 DO ORD
IF +($GET(GMTSEXIT))=0
DO CHK
+16 IF +($GET(GMTSCHG))'>0
WRITE !!,?2,"No Changes Made"
+17 QUIT
ORD ; Order of Entities
+1 NEW GMTSI,GMTST,GMTSC,GMTSCNT,GMTSTOT,GMTSREM,GMTSSO,GMTSNXT,GMTSNXC,GMTSON
+2 SET (GMTSSO,GMTSCNT,GMTSI,GMTSON)=0
SET (GMTSTOT,GMTST)=$$TOT
IF +GMTSTOT'>1
QUIT
+3 SET GMTSEXIT=0
SET GMTSCONT=$$CONT
IF +GMTSCONT>0
SET GMTSEXIT=1
QUIT
+4 WRITE !!," Please select the order in which you want these to be entities"
+5 WRITE !," to be used."
FOR
IF +($GET(GMTSEXIT))>0
QUIT
DO SO
IF +($GET(GMTSEXIT))>0
QUIT
IF '$DATA(GMTSOLD)
QUIT
+6 SET GMTSEXIT=0
+7 QUIT
+8 ;
SO ; Select Order
+1 KILL GMTSOLD("B")
NEW GMTSI,GMTSC,GMTSMAX,GMTSREO
SET GMTSI=0
SET GMTSREM=$$TOT
+2 SET GMTSCNT=GMTSTOT-GMTSREM
SET GMTSNXT=GMTSCNT+1
SET GMTSSO=+($GET(GMTSSO))+1
+3 SET GMTSNXC=$SELECT(GMTSNXT=1:(GMTSNXT_"st"),GMTSNXT=2:(GMTSNXT_"nd"),GMTSNXT=3:(GMTSNXT_"rd"),1:(GMTSNXT_"th"))
+4 IF +GMTSREM=1
SET Y=+GMTSREM
DO SET
QUIT
+5 WRITE !
DO SOL
DO REO
SET (GMTSC,GMTSI)=0
+6 SET GMTSMAX=GMTSREM
WRITE !
NEW DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
+7 SET DIR(0)="NAO^1:"_GMTSMAX_":0"
SET DIR("?")="^D SOH1^GMTSXAR"
SET DIR("??")="^D SOH2^GMTSXAR"
+8 SET DIR("A")=" Select the "_GMTSNXC_" entity to be used: "
+9 KILL DIR("B")
IF +($ORDER(GMTSREO(0)))>0
SET DIR("B")=+($ORDER(GMTSREO(0)))
+10 DO ^DIR
IF Y=""
IF X="@"
Begin DoDot:1
+11 NEW GMTSD
SET GMTSD=$PIECE($GET(^GMT(142.98,+($GET(GMTSUSR)),1)),"^",2)
+12 SET GMTSEXIT="1^"_$SELECT($LENGTH(GMTSD):"",1:"exiting")
+13 SET Y="@"
KILL GMTSORD
SET GMTSORD("@")=""
End DoDot:1
+14 IF Y["^"!($DATA(DUOUT))!($DATA(DIROUT))
SET GMTSEXIT="1^exiting"
IF $DATA(DTOUT)
SET GMTSEXIT="1^try later"
+15 IF +($GET(GMTSEXIT))>0
WRITE $SELECT($LENGTH($PIECE(GMTSEXIT,"^",2)):"...",1:""),$PIECE(GMTSEXIT,"^",2)
QUIT
+16 IF +Y>0
IF +Y'>GMTSREM
DO SET
+17 QUIT
SOL ; List
+1 NEW GMTSN,GMTSA,GMTST,GMTSC,GMTSI
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSOLD(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+2 SET GMTSC=GMTSC+1
SET GMTSA=$PIECE(GMTSOLD(GMTSI),"^",4)
SET GMTSN=$PIECE(GMTSOLD(GMTSI),"^",5)
+3 SET GMTST=GMTSN_$SELECT(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
+4 WRITE !,?5,$JUSTIFY(GMTSC,4)," ",GMTST
End DoDot:1
+5 QUIT
SOH1 ; Help - Single ?
+1 NEW GMTSC,GMTSI,GMTSN,GMTSCT
SET (GMTSC,GMTSI)=0
SET GMTSCT=+($GET(GMTSNXT))
FOR
SET GMTSI=$ORDER(GMTSOLD(GMTSI))
IF +GMTSI=0
QUIT
SET GMTSC=GMTSC+1
+2 SET GMTSN=$SELECT(GMTSCT=1:"first",GMTSCT=2:"second",GMTSCT=3:"third",GMTSCT=4:"fourth",GMTSCT=5:"fifty",GMTSCT=6:"sixth",GMTSCT=7:"seventh",GMTSCT=8:"eighth",GMTSCT=9:"nineth",GMTSCT=10:"tenth",GMTSCT=11:"eleventh",1:"")
+3 IF '$LENGTH(GMTSN)
IF +GMTSC>1
WRITE !,?11,"Select a Health Summary Type entity to list"
IF $LENGTH($GET(GMTSNXC))
WRITE " ",GMTSNXC
WRITE " (1-",GMTSC,")",!
+4 IF $LENGTH(GMTSN)
IF +GMTSC>1
WRITE !,?11,"Select a Health Summary Type entity to list ",GMTSN," (1-",GMTSC,")",!
+5 DO SOL
+6 QUIT
SOH2 ; Help - Double ??
+1 IF '$LENGTH($GET(GMTSPARM))
DO SOH1
QUIT
+2 WRITE !,?11,"Parameter """,GMTSPARM,""" has multiple "
+3 WRITE !,?11,"allowable entities for which Health Summary Types may"
+4 WRITE !,?11,"be assigned and displayed on the CPRS reports tab. Now"
+5 WRITE !,?11,"you must select the order in which you want these entites"
+6 WRITE !,?11,"to be used by the site.",!
+7 DO SOL
+8 QUIT
+9 ;
+10 ; Arrange
SET ; Set Order
+1 DO REO
NEW GMTSO
SET GMTSO=+($ORDER(GMTSORD(" "),-1))+1
+2 IF $LENGTH($PIECE($GET(GMTSREO(+($GET(Y)))),"^",2,299))
Begin DoDot:1
+3 SET GMTSON=$ORDER(GMTSEQ(GMTSON))
+4 SET GMTSORD(GMTSO)=GMTSON_"^"_$PIECE($GET(GMTSREO(+Y)),"^",2,299)
End DoDot:1
+5 SET (GMTSC,GMTSI)=0
+6 FOR
SET GMTSI=$ORDER(GMTSOLD(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+7 SET GMTSC=GMTSC+1
IF GMTSC=+Y
KILL GMTSOLD(GMTSI),GMTSREO(GMTSC)
End DoDot:1
+8 QUIT
REO ; Re-order
+1 KILL GMTSREO
NEW GMTSC,GMTSI
SET (GMTSC,GMTSI)=0
+2 FOR
SET GMTSI=$ORDER(GMTSOLD(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+3 SET GMTSC=GMTSC+1
SET GMTSREO(GMTSC)=$GET(GMTSOLD(GMTSI))
End DoDot:1
+4 QUIT
TOT(X) ; Total Allowable Entities
+1 NEW GMTSI
SET (X,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSOLD(GMTSI))
IF +GMTSI=0
QUIT
SET X=X+1
+2 QUIT X
CONT(X) ; Ask to Continue
+1 IF $ORDER(GMTSCUR(0))=0!('$LENGTH($GET(GMTSPARM)))!(+($GET(GMTSTOT))'>1)
SET GMTSEXIT=1
+2 IF $ORDER(GMTSCUR(0))=0!('$LENGTH($GET(GMTSPARM)))!(+($GET(GMTSTOT))'>1)
QUIT 0
+3 WRITE !!!," Parameter """,GMTSPARM,""" has ",GMTSTOT," allowable entities"
+4 WRITE !," which may have the Health Summary Types on the CPRS reports tab "
+5 WRITE !," and are used in the following order:"
+6 NEW DIR,DIROUT,DUOUT,DTOUT,GMTSA,GMTSN,GMTST,GMTSC,GMTSI
DO CONTM
+7 SET DIR("A")=" Are these in the correct order for your site? "
+8 SET (DIR("?"),DIR("??"))="^D CONTH^GMTSXAR"
SET DIR("B")="Y"
SET DIR(0)="YAO"
WRITE !
DO ^DIR
+9 SET X=+($GET(Y))
QUIT X
+10 QUIT 1
CONTH ; Continue Help
+1 WRITE !," Enter either 'Y' or 'N'"
+2 DO CONTM
QUIT
CONTM ; Continue Menu
+1 SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSCUR(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+2 SET GMTSA=$PIECE(GMTSCUR(GMTSI),"^",4)
SET GMTSN=$PIECE(GMTSCUR(GMTSI),"^",5)
+3 SET GMTST=GMTSN_$SELECT(GMTSA="DEV"!(GMTSA="DIV")!(GMTSA="SYS")!(GMTSA="PKG")!(GMTSA="LOC")!(GMTSA="BED"):" level ",1:" ")_"defined Health Summary Types"
+4 SET GMTSC=GMTSC+1
IF GMTSC=1
WRITE !
WRITE !,$JUSTIFY(GMTSC,6)," ",GMTST
End DoDot:1
+5 QUIT
CHK ; Check if OK
+1 NEW GMTSC,GMTSI,GMTSA
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSCUR(GMTSI))
IF +GMTSI=0
QUIT
IF GMTSCUR(GMTSI)'[$GET(GMTSORD(GMTSI))
SET GMTSC=1
+2 IF 'GMTSC
SET GMTSCHG=0
QUIT
+3 WRITE !!,?8,"You have selected to resequenced the Health Summary Type"
+4 WRITE !,?8,"entities in the following order:",!
+5 DO CHKM
SET GMTSA=$$OK
IF +($GET(GMTSA))>0
DO ED
+6 QUIT
CHKM ; Check (Menu)
+1 NEW GMTSC,GMTSI
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSCUR(GMTSI))
IF +GMTSI=0
QUIT
IF GMTSCUR(GMTSI)'[$GET(GMTSORD(GMTSI))
SET GMTSC=1
+2 IF 'GMTSC
QUIT
SET (GMTSC,GMTSI)=0
FOR
SET GMTSI=$ORDER(GMTSCUR(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+3 SET GMTSC=GMTSC+1
IF GMTSC=1
WRITE !,?13,"FROM (Current)",?33,"TO (Resequenced)",!,?13,"----------------",?33,"----------------"
+4 WRITE !,?7,$JUSTIFY(GMTSC,4),?13,$PIECE($GET(GMTSCUR(GMTSI)),"^",5),?33,$PIECE($GET(GMTSORD(GMTSI)),"^",5)
End DoDot:1
+5 QUIT
OK(X) ; Ask if OK
+1 WRITE !
NEW DIR,DIROUT,DUOUT,DTOUT
SET (DIR("?"),DIR("??"))="^D OKH^GMTSXAR"
+2 SET DIR("A")=" Is this OK? "
SET DIR("B")="Y"
SET DIR(0)="YAO"
DO ^DIR
SET X=+($GET(Y))
QUIT X
OKH ; OK Help
+1 WRITE !," Enter either 'Y' or 'N'",!,!," Resequence entities:",!
DO CHKM
QUIT
+2 ;
ED ; Edit Record
+1 NEW DIC,DA,DIE,DR,DIDEL,DTOUT,GMTSFI,GMTSI,GMTSEQ,GMTSCNT,GMTST
+2 SET GMTSPI=+($GET(GMTSPI))
SET GMTSCNT=0
+3 IF GMTSPI'>0!(+($ORDER(GMTSORD(0)))'>0)!('$LENGTH($GET(GMTSPARM)))!($$PDN^GMTSXAW3(+GMTSPI)'=$GET(GMTSPARM))
Begin DoDot:1
+4 WRITE !,?5," Unable to resequence at this time."
End DoDot:1
QUIT
+5 SET DA(1)=+($GET(GMTSPI))
IF DA(1)'>0
QUIT
SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
SET DR=".02///^S X=$G(GMTSFI)"
L ; Lock Record
+1 LOCK +^XTV(8989.51,+($GET(GMTSPI)))
SET GMTSCNT=GMTSCNT+1
SET GMTST=$TEST
+2 IF 'GMTST
IF GMTSCNT'>3
HANG 2
GOTO L
+3 IF 'GMTST
IF GMTSCNT>3
WRITE !," Another user is editing this entry.",!," Unable to resequence at this time."
QUIT
+4 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSORD(GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:1
+5 SET GMTSFI=$PIECE(GMTSORD(GMTSI),"^",2)
SET GMTSEQ=$PIECE(GMTSORD(GMTSI),"^",1)
+6 SET DA=$$DA(DA(1),GMTSEQ)
SET X=GMTSEQ
DO ^DIE
SET GMTSCHG=1
End DoDot:1
+7 LOCK -^XTV(8989.51,+($GET(GMTSPI)))
+8 QUIT
DA(GMTSI,X) ; Get DA
+1 NEW DA,DIC,DTOUT,DUOUT,Y,GMTSM
SET DA(1)=+($GET(GMTSI))
SET X=+($GET(X))
+2 SET DIC="^XTV(8989.51,"_DA(1)_",30,"
SET DIC(0)="M"
DO ^DIC
SET X=+($GET(Y))
QUIT X
+3 QUIT
+4 ;
ADED ; Add/Edit
+1 NEW X,Y,DA,DIC,DIE,DLAYGO,DR,DTOUT,DUOUT,GMTSCNT,GMTSDEF,GMTSENT
+2 NEW GMTSM,GMTSMGR,GMTSNEW,GMTSPARM,GMTSPI,GMTST
+3 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+4 SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
+5 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
IF +GMTSPI=0
QUIT
+6 WRITE !!
IF $LENGTH(GMTSPARM)
WRITE "'"
WRITE GMTSPARM
IF $LENGTH(GMTSPARM)
WRITE "' "
WRITE "ALLOWABLE ENTITIES",!
+7 SET DA(1)=+($GET(GMTSPI))
SET GMTSCNT=0
+8 SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
SET DIC(0)="AEQMLZ"
+9 SET DIC("DR")=".02///^S X=$$AE^GMTSXAR(+($G(Y)))"
+10 SET DLAYGO=""
DO FIELD^DID(8989.51,30,"","SPECIFIER","GMTST(""DID"")","GMTSM(""ERR"")")
+11 IF $LENGTH($GET(GMTST("DID","SPECIFIER")))
SET DIC("P")=$GET(GMTST("DID","SPECIFIER"))
L2 ; Lock Record
+1 LOCK +^XTV(8989.51,+($GET(GMTSPI)))
SET GMTSCNT=GMTSCNT+1
SET GMTST=$TEST
+2 IF 'GMTST
IF GMTSCNT'>3
HANG 2
GOTO L2
+3 IF 'GMTST
IF GMTSCNT>3
WRITE !," Another user is editing this entry.",!," Unable to resequence at this time."
QUIT
+4 DO ^DIC
SET GMTSNEW=+($PIECE($GET(Y),"^",3))
IF GMTSNEW>0
QUIT
IF +Y'>0
QUIT
+5 NEW DIC,DIE
SET DA(1)=GMTSPI
SET DA=+($GET(Y))
SET (DIC,DIE)="^XTV(8989.51,"_DA(1)_",30,"
+6 SET DA=+($GET(Y))
SET DR=".01;.02///^S X=$$AE^GMTSXAR("_DA_")"
+7 DO ^DIE
LOCK -^XTV(8989.51,+($GET(GMTSPI)))
+8 QUIT
AE(X) ; Allowable Entity
+1 NEW DA,DIC,DTOUT,DUOUT,Y,GMTSPARM,GMTSPI,GMTSENT,GMTSDEF
+2 SET GMTSDEF=""
SET GMTSENT=+($GET(X))
SET GMTSPARM="ORWRP HEALTH SUMMARY TYPE LIST"
+3 SET GMTSPI=$$PDI^GMTSXAW3(GMTSPARM)
IF +GMTSPI=0
QUIT ""
+4 IF +GMTSENT>0
SET GMTSDEF=$$GET1^DIQ(8989.513,(GMTSENT_","_GMTSPI_","),.02)
+5 NEW DA,DIC,DTOUT,DUOUT,Y
SET DIC="^XTV(8989.518,"
SET DIC(0)="AEMQ"
+6 SET DIC("S")="I Y'=3.5&(Y'=9.4)&(Y'=44)&(Y'=404.51)&(Y'=405.4)"
+7 IF $LENGTH($GET(GMTSDEF))
SET DIC("B")=GMTSDEF
DO ^DIC
SET X=+($GET(Y))
+8 QUIT X
