GMTSXA ; SLC/KER - List Parameters ; 02/27/2002
;;2.7;Health Summary;**47,49**;Oct 20, 1995
Q
;
; External References in GMTSXA
;
; DBIA 2336 EDITPAR^XPAREDIT
; DBIA 2336 EDIT^XPAREDIT
; DBIA 2343 $$ACTIVE^XUSER
; DBIA 10086 HOME^%ZIS
;
DISP ; Display User Defaults
G:+($G(DUZ))=.5 DS N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3
D:+GMTSMGR>0&(+($G(DUZ))>.9) DM D:+GMTSMGR'>0&(+($G(DUZ))>.9) DU Q
DU ; Display - User Entry Point
N GMTSENV S GMTSENV=$$ENV Q:+GMTSENV'>0 D EN^GMTSXAD Q
DM ; Display - Manager Entry Point
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
S GMTSUSR=$$USR^GMTSXAW3("Display defaults for user: ")
W:+GMTSUSR>0 ! D:+GMTSUSR>0 EN2^GMTSXAD(GMTSUSR) Q
DS ; Display - Manager Entry Point
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0 S GMTSUSR=.5 W !
D EN3^GMTSXAD Q
;
PREC ; Set Precedence
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 D:+GMTSMGR>0 PM D:+GMTSMGR'>0 PU Q
PU ; Precedence - User Entry Point
N GMTSENV S GMTSENV=$$ENV Q:+GMTSENV'>0 D EN^GMTSXAP Q
PM ; Precedence - Manager Entry Point
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
S GMTSUSR=$$USR^GMTSXAW3("Set Health Summary Precedence for user: ")
W:+GMTSUSR>0 ! D:+GMTSUSR>0 EN2^GMTSXAP(GMTSUSR) Q
PS ; Precedence - Site
D ADED^GMTSXAR Q
RS ; Resequence Site Precedence
D EN^GMTSXAR Q
;
METH ; Set Method of Building List
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 D:+GMTSMGR>0 MM D:+GMTSMGR'>0 MU Q
MU ; Method - User Entry Point
N GMTSENV S GMTSENV=$$ENV Q:+GMTSENV'>0 D EN^GMTSXAO Q
MM ; Method - Manager Entry Point
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
S GMTSUSR=$$USR^GMTSXAW3("Set Method of Building list for user: ")
W:+GMTSUSR>0 ! D:+GMTSUSR>0 EN2^GMTSXAO(GMTSUSR) Q
MS ; Method - Default for Site Wide
N GMTSUSR S GMTSUSR=.5 D EN3^GMTSXAO Q
;
EDIT ; Edit Type List
N GMTSENV,GMTSMGR S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 D:+GMTSMGR>0 EM D:+GMTSMGR'>0 EU Q
EU ; Edit List - User Entry Point
N GMTSENV S GMTSENV=$$ENV Q:+GMTSENV'>0 D EL(+($G(DUZ))) Q
EM ; Edit List - Manager Entry Point
N GMTSENV,GMTSMGR,GMTSLST S GMTSENV=$$ENV Q:+GMTSENV'>0
S GMTSMGR=$$MGR^GMTSXAW3 Q:GMTSMGR'>0
W ! D EDITPAR^XPAREDIT("ORWRP HEALTH SUMMARY TYPE LIST")
Q
EL(X) ; Edit List
N GMTSENT,GMTSVEN,GMTSPAR,GMTSUSR,GMTSACT S GMTSUSR=+($G(X))
Q:'$L($$UNM^GMTSXAW3(+($G(GMTSUSR))))
S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)
D:+GMTSACT'>0 DP^GMTSXAP2(+GMTSUSR) Q:+GMTSACT'>0
S GMTSPAR=$$PDI^GMTSXAW3("ORWRP HEALTH SUMMARY TYPE LIST")
Q:+GMTSPAR'>0 S GMTSENT=$$ETI^GMTSXAW3("USR") Q:+GMTSENT'>0
S GMTSVEN=$$UVP^GMTSXAW3(+($G(GMTSUSR)))
W !!,"Edit the CPRS Health Summary Types list on the reports tab"
D EDIT^XPAREDIT(GMTSVEN,(+GMTSPAR_"^GUI Health Summary Type List")) W !
Q
;
; Miscellaneous
ENV(X) ; Environment check
D HOME^%ZIS S U="^" Q:'$L($$UNM^GMTSXAW3(+($G(DUZ)))) 0
Q 1
LP ; List Preferences
N GMTSN,GMTSS,GMTSI,GMTSM,GMTSP,GMTSC,GMTSNUM S GMTSN="",GMTSC=0
F S GMTSN=$O(^GMT(142.98,"AB",GMTSN)) Q:GMTSN="" D
. S GMTSI=0 F S GMTSI=$O(^GMT(142.98,"AB",GMTSN,GMTSI)) Q:+GMTSI=0 D
. . S GMTSM=$G(^GMT(142.98,+GMTSI,1)),GMTSP=$P(GMTSM,"^",2)
. . S GMTSM=$S(+GMTSM=1:"Append ",1:"Overwrite")
. . S GMTSNUM=$$NUM^GMTSXAL(+GMTSI) S GMTSC=GMTSC+1 I GMTSC=1 D
. . . W !!,"Health Summary Preferences",!!," Name ",?24," Method"
. . . W ?36," Precedence",?59," Types"
. . . W !," --------------------",?24," ---------"
. . . W ?36," -------------------",?59," -----"
. . . S GMTSD=$$DEF^GMTSXAW
. . . I $L(GMTSD) D
. . . . W !," <default>",?24," Append",?36," ",GMTSD,?59," <all>"
. . W !,?2,$E(GMTSN,1,20),?24," ",GMTSM,?36," ",GMTSP
. . W ?59," ",$J(+GMTSNUM,2)
W !
Q
TRIM(X,Y,I) ; Trim Character
S X=$G(X),Y=$G(Y),I=+($G(I)) Q:'$L(X) X
S:'$L(Y) Y=" " S:I=0 I=3 F Q:$E(X,1)'=Y S X=$E(X,2,$L(X))
I +I>1 F Q:$E(X,$L(X))'=Y S X=$E(X,1,($L(X)-1))
I I>2 F Q:X'[(Y_Y) S X=$P(X,(Y_Y),1)_Y_$P(X,(Y_Y),2,229)
Q X
UP(X) ; Uppercase
Q $TR($G(X),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
GMTSXA ; SLC/KER - List Parameters ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References in GMTSXA
+5 ;
+6 ; DBIA 2336 EDITPAR^XPAREDIT
+7 ; DBIA 2336 EDIT^XPAREDIT
+8 ; DBIA 2343 $$ACTIVE^XUSER
+9 ; DBIA 10086 HOME^%ZIS
+10 ;
DISP ; Display User Defaults
+1 IF +($GET(DUZ))=.5
GOTO DS
NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
+3 IF +GMTSMGR>0&(+($GET(DUZ))>.9)
DO DM
IF +GMTSMGR'>0&(+($GET(DUZ))>.9)
DO DU
QUIT
DU ; Display - User Entry Point
+1 NEW GMTSENV
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
DO EN^GMTSXAD
QUIT
DM ; Display - Manager Entry Point
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+3 SET GMTSUSR=$$USR^GMTSXAW3("Display defaults for user: ")
+4 IF +GMTSUSR>0
WRITE !
IF +GMTSUSR>0
DO EN2^GMTSXAD(GMTSUSR)
QUIT
DS ; Display - Manager Entry Point
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
SET GMTSUSR=.5
WRITE !
+2 DO EN3^GMTSXAD
QUIT
+3 ;
PREC ; Set Precedence
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF +GMTSMGR>0
DO PM
IF +GMTSMGR'>0
DO PU
QUIT
PU ; Precedence - User Entry Point
+1 NEW GMTSENV
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
DO EN^GMTSXAP
QUIT
PM ; Precedence - Manager Entry Point
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+3 SET GMTSUSR=$$USR^GMTSXAW3("Set Health Summary Precedence for user: ")
+4 IF +GMTSUSR>0
WRITE !
IF +GMTSUSR>0
DO EN2^GMTSXAP(GMTSUSR)
QUIT
PS ; Precedence - Site
+1 DO ADED^GMTSXAR
QUIT
RS ; Resequence Site Precedence
+1 DO EN^GMTSXAR
QUIT
+2 ;
METH ; Set Method of Building List
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF +GMTSMGR>0
DO MM
IF +GMTSMGR'>0
DO MU
QUIT
MU ; Method - User Entry Point
+1 NEW GMTSENV
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
DO EN^GMTSXAO
QUIT
MM ; Method - Manager Entry Point
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+3 SET GMTSUSR=$$USR^GMTSXAW3("Set Method of Building list for user: ")
+4 IF +GMTSUSR>0
WRITE !
IF +GMTSUSR>0
DO EN2^GMTSXAO(GMTSUSR)
QUIT
MS ; Method - Default for Site Wide
+1 NEW GMTSUSR
SET GMTSUSR=.5
DO EN3^GMTSXAO
QUIT
+2 ;
EDIT ; Edit Type List
+1 NEW GMTSENV,GMTSMGR
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF +GMTSMGR>0
DO EM
IF +GMTSMGR'>0
DO EU
QUIT
EU ; Edit List - User Entry Point
+1 NEW GMTSENV
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
DO EL(+($GET(DUZ)))
QUIT
EM ; Edit List - Manager Entry Point
+1 NEW GMTSENV,GMTSMGR,GMTSLST
SET GMTSENV=$$ENV
IF +GMTSENV'>0
QUIT
+2 SET GMTSMGR=$$MGR^GMTSXAW3
IF GMTSMGR'>0
QUIT
+3 WRITE !
DO EDITPAR^XPAREDIT("ORWRP HEALTH SUMMARY TYPE LIST")
+4 QUIT
EL(X) ; Edit List
+1 NEW GMTSENT,GMTSVEN,GMTSPAR,GMTSUSR,GMTSACT
SET GMTSUSR=+($GET(X))
+2 IF '$LENGTH($$UNM^GMTSXAW3(+($GET(GMTSUSR))))
QUIT
+3 SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)
+4 IF +GMTSACT'>0
DO DP^GMTSXAP2(+GMTSUSR)
IF +GMTSACT'>0
QUIT
+5 SET GMTSPAR=$$PDI^GMTSXAW3("ORWRP HEALTH SUMMARY TYPE LIST")
+6 IF +GMTSPAR'>0
QUIT
SET GMTSENT=$$ETI^GMTSXAW3("USR")
IF +GMTSENT'>0
QUIT
+7 SET GMTSVEN=$$UVP^GMTSXAW3(+($GET(GMTSUSR)))
+8 WRITE !!,"Edit the CPRS Health Summary Types list on the reports tab"
+9 DO EDIT^XPAREDIT(GMTSVEN,(+GMTSPAR_"^GUI Health Summary Type List"))
WRITE !
+10 QUIT
+11 ;
+12 ; Miscellaneous
ENV(X) ; Environment check
+1 DO HOME^%ZIS
SET U="^"
IF '$LENGTH($$UNM^GMTSXAW3(+($GET(DUZ))))
QUIT 0
+2 QUIT 1
LP ; List Preferences
+1 NEW GMTSN,GMTSS,GMTSI,GMTSM,GMTSP,GMTSC,GMTSNUM
SET GMTSN=""
SET GMTSC=0
+2 FOR
SET GMTSN=$ORDER(^GMT(142.98,"AB",GMTSN))
IF GMTSN=""
QUIT
Begin DoDot:1
+3 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^GMT(142.98,"AB",GMTSN,GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:2
+4 SET GMTSM=$GET(^GMT(142.98,+GMTSI,1))
SET GMTSP=$PIECE(GMTSM,"^",2)
+5 SET GMTSM=$SELECT(+GMTSM=1:"Append ",1:"Overwrite")
+6 SET GMTSNUM=$$NUM^GMTSXAL(+GMTSI)
SET GMTSC=GMTSC+1
IF GMTSC=1
Begin DoDot:3
+7 WRITE !!,"Health Summary Preferences",!!," Name ",?24," Method"
+8 WRITE ?36," Precedence",?59," Types"
+9 WRITE !," --------------------",?24," ---------"
+10 WRITE ?36," -------------------",?59," -----"
+11 SET GMTSD=$$DEF^GMTSXAW
+12 IF $LENGTH(GMTSD)
Begin DoDot:4
+13 WRITE !," <default>",?24," Append",?36," ",GMTSD,?59," <all>"
End DoDot:4
End DoDot:3
+14 WRITE !,?2,$EXTRACT(GMTSN,1,20),?24," ",GMTSM,?36," ",GMTSP
+15 WRITE ?59," ",$JUSTIFY(+GMTSNUM,2)
End DoDot:2
End DoDot:1
+16 WRITE !
+17 QUIT
TRIM(X,Y,I) ; Trim Character
+1 SET X=$GET(X)
SET Y=$GET(Y)
SET I=+($GET(I))
IF '$LENGTH(X)
QUIT X
+2 IF '$LENGTH(Y)
SET Y=" "
IF I=0
SET I=3
FOR
IF $EXTRACT(X,1)'=Y
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+3 IF +I>1
FOR
IF $EXTRACT(X,$LENGTH(X))'=Y
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+4 IF I>2
FOR
IF X'[(Y_Y)
QUIT
SET X=$PIECE(X,(Y_Y),1)_Y_$PIECE(X,(Y_Y),2,229)
+5 QUIT X
UP(X) ; Uppercase
+1 QUIT $TRANSLATE($GET(X),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
