GMTSXAO ; SLC/KER - List Parameters/Overwrite ; 02/27/2002
;;2.7;Health Summary;**47,49**;Oct 20, 1995
Q
;
; External References
; DBIA 2343 $$ACTIVE^XUSER
; DBIA 10006 ^DIC
; DBIA 10026 ^DIR
; DBIA 10018 ^DIE
; DBIA 10013 ^DIK
;
EN ; Main Entry Point for Health Summary
N GMTSUSR,GMTSACT S GMTSUSR=+($G(DUZ)) D PREF Q
;
EN2(X) ; Entry Point for User
N GMTSUSR,GMTSACT S GMTSUSR=+($G(X)) D PREF Q
;
EN3 ; Entry Point for Site
N X,GMTSALW,GMTSPRE,GMTSCPL,GMTSUSR,GMTSACT,GMTSEL S GMTSUSR=.5
D EN2^GMTSXAW(+($G(GMTSUSR))) S:$L($G(GMTSALW("ALLOWABLE")))>2 GMTSEL=$G(GMTSALW("ALLOWABLE"))
Q:'$L($G(GMTSEL)) S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"")
S:$L(X) ^GMT(142.98,"ASITE")=X
Q
PREF ; Get Preference - Append/Overwrite
Q:'$L($$UNM^GMTSXAW3(+($G(GMTSUSR)))) S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0
N GMTSEL,GMTSALW,GMTSPRE,GMTSCPL S GMTSEL=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
D EN2^GMTSXAW(+($G(GMTSUSR))) S:'$L(GMTSEL)&($L($G(GMTSALW("ALLOWABLE")))>2) GMTSEL=$G(GMTSALW("ALLOWABLE"))_";NAT"
S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"") D:$L(X) EDIT(GMTSUSR,X)
Q
;
CPL(X) ; Compile List (Append or Overwrite)
Q:'$L($G(X)) 0 Q:$L($G(X),";")<2 0
N Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSPRE,GMTSI,GMTST,GMTSA,GMTSO S GMTSPRE=$G(X)
I +($G(GMTSUSR))'=.5 D
. W !!,"Default Method for building 'Health Summary Types'"
. W !,"List on the CPRS Reports Tab",!
I +($G(GMTSUSR))=.5 D
. W !!,"Site Default Method for building 'Health Summary Types'"
. W !,"List on the CPRS Reports Tab",!
W !,?3,"Append selected Health Summary Types to the list",!,?3,"Overwrite selected Health Summary Types to the list",!
S DIR(0)="SAO^A:Append;O:Overwrite",DIR("A")="Select Append/Overwrite (A/O): "
S DIR("B")="A",DIR("?")="^D EN1^GMTSXAC",DIR("??")="^D EN2^GMTSXAC"
D ^DIR S X=Y
Q X
;
EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"
N DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA
S GMTSDAT=+($G(X)),GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0
S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0
S GMTSPREF=$$PENT(GMTSUSR) Q:+GMTSPREF'>0
S DIE="^GMT(142.98,",DA=+($G(GMTSUSR)),DR="10///^S X=+GMTSDAT"
ED ; Lock Record, Edit Entry
L +^GMT(142.98,+GMTSPREF):0 I $T D ^DIE L -^GMT(142.98,+GMTSPREF) Q
S GMTSA=+($G(GMTSA))+1 Q:GMTSA>3 H 1 G ED
Q
;
; Miscellaneous
PENT(GMTSUSR) ; Get User Preferred Entry
N DIC,DTOUT,DUOUT,GMTSACT,DLAYGO S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 -1
S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 -1
S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X) -1
S DIC="^GMT(142.98,",DIC(0)="LM",DLAYGO=142.98 D ^DIC
S X=+($G(Y)) Q X
DP(X) ; Delete User Preferece of Inactive User
N DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR S GMTSUSR=+($G(X)),X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)
S DIC="^GMT(142.98,",DIC(0)="M" D ^DIC I +Y>0 S DIK=DIC,DA=+Y D ^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXAO 3145 printed Dec 13, 2024@02:00:48 Page 2
GMTSXAO ; SLC/KER - List Parameters/Overwrite ; 02/27/2002
+1 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
+2 QUIT
+3 ;
+4 ; External References
+5 ; DBIA 2343 $$ACTIVE^XUSER
+6 ; DBIA 10006 ^DIC
+7 ; DBIA 10026 ^DIR
+8 ; DBIA 10018 ^DIE
+9 ; DBIA 10013 ^DIK
+10 ;
EN ; Main Entry Point for Health Summary
+1 NEW GMTSUSR,GMTSACT
SET GMTSUSR=+($GET(DUZ))
DO PREF
QUIT
+2 ;
EN2(X) ; Entry Point for User
+1 NEW GMTSUSR,GMTSACT
SET GMTSUSR=+($GET(X))
DO PREF
QUIT
+2 ;
EN3 ; Entry Point for Site
+1 NEW X,GMTSALW,GMTSPRE,GMTSCPL,GMTSUSR,GMTSACT,GMTSEL
SET GMTSUSR=.5
+2 DO EN2^GMTSXAW(+($GET(GMTSUSR)))
if $LENGTH($GET(GMTSALW("ALLOWABLE")))>2
SET GMTSEL=$GET(GMTSALW("ALLOWABLE"))
+3 if '$LENGTH($GET(GMTSEL))
QUIT
SET X=$$CPL(GMTSEL)
SET X=$SELECT(X="O":0,X="A":1,1:"")
+4 if $LENGTH(X)
SET ^GMT(142.98,"ASITE")=X
+5 QUIT
PREF ; Get Preference - Append/Overwrite
+1 if '$LENGTH($$UNM^GMTSXAW3(+($GET(GMTSUSR))))
QUIT
SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)
if +GMTSACT'>0
DO DP(GMTSUSR)
if +GMTSACT'>0
QUIT
+2 NEW GMTSEL,GMTSALW,GMTSPRE,GMTSCPL
SET GMTSEL=$PIECE($GET(^GMT(142.98,+($GET(GMTSUSR)),1)),"^",2)
+3 DO EN2^GMTSXAW(+($GET(GMTSUSR)))
if '$LENGTH(GMTSEL)&($LENGTH($GET(GMTSALW("ALLOWABLE")))>2)
SET GMTSEL=$GET(GMTSALW("ALLOWABLE"))_";NAT"
+4 SET X=$$CPL(GMTSEL)
SET X=$SELECT(X="O":0,X="A":1,1:"")
if $LENGTH(X)
DO EDIT(GMTSUSR,X)
+5 QUIT
+6 ;
CPL(X) ; Compile List (Append or Overwrite)
+1 if '$LENGTH($GET(X))
QUIT 0
if $LENGTH($GET(X),";")<2
QUIT 0
+2 NEW Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSPRE,GMTSI,GMTST,GMTSA,GMTSO
SET GMTSPRE=$GET(X)
+3 IF +($GET(GMTSUSR))'=.5
Begin DoDot:1
+4 WRITE !!,"Default Method for building 'Health Summary Types'"
+5 WRITE !,"List on the CPRS Reports Tab",!
End DoDot:1
+6 IF +($GET(GMTSUSR))=.5
Begin DoDot:1
+7 WRITE !!,"Site Default Method for building 'Health Summary Types'"
+8 WRITE !,"List on the CPRS Reports Tab",!
End DoDot:1
+9 WRITE !,?3,"Append selected Health Summary Types to the list",!,?3,"Overwrite selected Health Summary Types to the list",!
+10 SET DIR(0)="SAO^A:Append;O:Overwrite"
SET DIR("A")="Select Append/Overwrite (A/O): "
+11 SET DIR("B")="A"
SET DIR("?")="^D EN1^GMTSXAC"
SET DIR("??")="^D EN2^GMTSXAC"
+12 DO ^DIR
SET X=Y
+13 QUIT X
+14 ;
EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"
+1 NEW DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA
+2 SET GMTSDAT=+($GET(X))
SET GMTSUSR=+($GET(GMTSUSR))
if GMTSUSR=0
QUIT
+3 SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)
if +GMTSACT'>0
DO DP(GMTSUSR)
if +GMTSACT'>0
QUIT
+4 SET GMTSPREF=$$PENT(GMTSUSR)
if +GMTSPREF'>0
QUIT
+5 SET DIE="^GMT(142.98,"
SET DA=+($GET(GMTSUSR))
SET DR="10///^S X=+GMTSDAT"
ED ; Lock Record, Edit Entry
+1 LOCK +^GMT(142.98,+GMTSPREF):0
IF $TEST
DO ^DIE
LOCK -^GMT(142.98,+GMTSPREF)
QUIT
+2 SET GMTSA=+($GET(GMTSA))+1
if GMTSA>3
QUIT
HANG 1
GOTO ED
+3 QUIT
+4 ;
+5 ; Miscellaneous
PENT(GMTSUSR) ; Get User Preferred Entry
+1 NEW DIC,DTOUT,DUOUT,GMTSACT,DLAYGO
SET GMTSUSR=+($GET(GMTSUSR))
if GMTSUSR=0
QUIT -1
+2 SET GMTSACT=$$ACTIVE^XUSER(+GMTSUSR)
if +GMTSACT'>0
DO DP(GMTSUSR)
if +GMTSACT'>0
QUIT -1
+3 SET X=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(X)
QUIT -1
+4 SET DIC="^GMT(142.98,"
SET DIC(0)="LM"
SET DLAYGO=142.98
DO ^DIC
+5 SET X=+($GET(Y))
QUIT X
DP(X) ; Delete User Preferece of Inactive User
+1 NEW DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR
SET GMTSUSR=+($GET(X))
SET X=$$UNM^GMTSXAW3(+($GET(GMTSUSR)))
if '$LENGTH(X)
QUIT
+2 SET DIC="^GMT(142.98,"
SET DIC(0)="M"
DO ^DIC
IF +Y>0
SET DIK=DIC
SET DA=+Y
DO ^DIK
+3 QUIT
