- 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")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXA 4549 printed Jan 18, 2025@03:01:55 Page 2
- 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")