source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXAO.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1GMTSXAO ; SLC/KER - List Parameters/Overwrite ; 02/27/2002
2 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
3 Q
4 ;
5 ; External References
6 ; DBIA 2343 $$ACTIVE^XUSER
7 ; DBIA 10006 ^DIC
8 ; DBIA 10026 ^DIR
9 ; DBIA 10018 ^DIE
10 ; DBIA 10013 ^DIK
11 ;
12EN ; Main Entry Point for Health Summary
13 N GMTSUSR,GMTSACT S GMTSUSR=+($G(DUZ)) D PREF Q
14 ;
15EN2(X) ; Entry Point for User
16 N GMTSUSR,GMTSACT S GMTSUSR=+($G(X)) D PREF Q
17 ;
18EN3 ; Entry Point for Site
19 N X,GMTSALW,GMTSPRE,GMTSCPL,GMTSUSR,GMTSACT,GMTSEL S GMTSUSR=.5
20 D EN2^GMTSXAW(+($G(GMTSUSR))) S:$L($G(GMTSALW("ALLOWABLE")))>2 GMTSEL=$G(GMTSALW("ALLOWABLE"))
21 Q:'$L($G(GMTSEL)) S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"")
22 S:$L(X) ^GMT(142.98,"ASITE")=X
23 Q
24PREF ; Get Preference - Append/Overwrite
25 Q:'$L($$UNM^GMTSXAW3(+($G(GMTSUSR)))) S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0
26 N GMTSEL,GMTSALW,GMTSPRE,GMTSCPL S GMTSEL=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
27 D EN2^GMTSXAW(+($G(GMTSUSR))) S:'$L(GMTSEL)&($L($G(GMTSALW("ALLOWABLE")))>2) GMTSEL=$G(GMTSALW("ALLOWABLE"))_";NAT"
28 S X=$$CPL(GMTSEL),X=$S(X="O":0,X="A":1,1:"") D:$L(X) EDIT(GMTSUSR,X)
29 Q
30 ;
31CPL(X) ; Compile List (Append or Overwrite)
32 Q:'$L($G(X)) 0 Q:$L($G(X),";")<2 0
33 N Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,GMTSPRE,GMTSI,GMTST,GMTSA,GMTSO S GMTSPRE=$G(X)
34 I +($G(GMTSUSR))'=.5 D
35 . W !!,"Default Method for building 'Health Summary Types'"
36 . W !,"List on the CPRS Reports Tab",!
37 I +($G(GMTSUSR))=.5 D
38 . W !!,"Site Default Method for building 'Health Summary Types'"
39 . W !,"List on the CPRS Reports Tab",!
40 W !,?3,"Append selected Health Summary Types to the list",!,?3,"Overwrite selected Health Summary Types to the list",!
41 S DIR(0)="SAO^A:Append;O:Overwrite",DIR("A")="Select Append/Overwrite (A/O): "
42 S DIR("B")="A",DIR("?")="^D EN1^GMTSXAC",DIR("??")="^D EN2^GMTSXAC"
43 D ^DIR S X=Y
44 Q X
45 ;
46EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"
47 N DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA
48 S GMTSDAT=+($G(X)),GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0
49 S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0
50 S GMTSPREF=$$PENT(GMTSUSR) Q:+GMTSPREF'>0
51 S DIE="^GMT(142.98,",DA=+($G(GMTSUSR)),DR="10///^S X=+GMTSDAT"
52ED ; Lock Record, Edit Entry
53 L +^GMT(142.98,+GMTSPREF):0 I $T D ^DIE L -^GMT(142.98,+GMTSPREF) Q
54 S GMTSA=+($G(GMTSA))+1 Q:GMTSA>3 H 1 G ED
55 Q
56 ;
57 ; Miscellaneous
58PENT(GMTSUSR) ; Get User Preferred Entry
59 N DIC,DTOUT,DUOUT,GMTSACT,DLAYGO S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 -1
60 S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 -1
61 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X) -1
62 S DIC="^GMT(142.98,",DIC(0)="LM",DLAYGO=142.98 D ^DIC
63 S X=+($G(Y)) Q X
64DP(X) ; Delete User Preferece of Inactive User
65 N DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR S GMTSUSR=+($G(X)),X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)
66 S DIC="^GMT(142.98,",DIC(0)="M" D ^DIC I +Y>0 S DIK=DIC,DA=+Y D ^DIK
67 Q
Note: See TracBrowser for help on using the repository browser.