source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSXAP2.m@ 619

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1GMTSXAP2 ; SLC/KER - List Parameters/Precedence 2 ; 02/27/2002
2 ;;2.7;Health Summary;**47,49**;Oct 20, 1995
3 Q
4 ;
5 ; External References in GMTSXAP2
6 ; DBIA 2056 $$GET1^DIQ
7 ; DBIA 2343 $$ACTIVE^XUSER
8 ; DBIA 10006 ^DIC
9 ; DBIA 10026 ^DIR
10 ; DBIA 10018 ^DIE
11 ; DBIA 10013 ^DIK
12 ;
13 ; Check to see if Compiled Order is correct
14OK(X) ; Ask if Ok
15 N Y,DIR,GMTSTOT,GMTSOLD S GMTSNEW=$G(GMTSNEW),GMTSOLD=$$OLD
16 S GMTSTOT=$$ORT S:GMTSTOT=1 X=$$OKO S:GMTSTOT>1 X=$$OKM S:GMTSTOT'>0 X=0
17 Q X
18OKM(X) ; Multiple entities selected i.e. USR;SYS
19 N DIR,Y,DIROUT,DUOUT,DTOUT S X=1 D OKA Q:'$D(DIR) 0
20 D YND
21 Q X
22OKO(X) ; Only one entity selected i.e. USR
23 I '$L($G(GMTSORD(1)))!($L($P(GMTSORD(1),"^",1))'=3)!($L($P(GMTSORD(1),"^",3))'>0) Q 0
24 N DIR,Y,DIROUT,DUOUT,DTOUT D OKA Q:'$D(DIR) 0
25 D YND
26 Q X
27OKA ; Set up Prompts - DIR("A")
28 N GMTSC,GMTSI,GMTST S (GMTSC,GMTSI)=0 S GMTST=$$ORT
29MUL ; Multiple Entities
30 I GMTST>1 D Q
31 . K DIR N GMTSTC,GMTSA,GMTSC S GMTSC=0,GMTSA=GMTST+4 S GMTSTC=$S(GMTST=2:"two",GMTST=3:"three",1:"several")
32 . S DIR("A",1)="",DIR("A",2)=" You have selected "_GMTSTC_" Health Summary Types, arranged "
33 . S DIR("A",3)=" in the following order:",DIR("A",4)=""
34 . F GMTSA=1:1:GMTST S DIR("A",(4+GMTSA))=" "_$J(GMTSA,2)_" "_$P($G(GMTSORD(+GMTSA)),"^",3)
35 . S GMTSA=+($O(DIR("A"," "),-1))+1,DIR("A",GMTSA)="",DIR("A")=" Is this precedence correct? (Y/N) ",DIR(0)="YAO",DIR("B")="Y"
36ONE ; One Entity
37 I GMTST=1 D Q
38 . I $L($G(GMTSORD(1))),$L($P(GMTSORD(1),"^",1))=3,$L($P(GMTSORD(1),"^",3))>0 D Q
39 . . K DIR S DIR("A",1)=""
40 . . S DIR("A",2)=" You have selected one Health Summary Type"
41 . . S DIR("A",3)=""
42 . . S DIR("A",4)=" "_$P($G(GMTSORD(1)),"^",3)
43 . . S DIR("A",5)=""
44 . . S DIR("A")=" Is this correct? (Y/N) "
45 . . S DIR(0)="YAO",DIR("B")="Y"
46 . K DIR
47 K DIR
48 Q
49 ;
50YND ; Yes/No/Delete
51 W ! S X=$G(X) S:$L($G(DIR("A"))) DIR("A")=" Is this correct? (Y/N) "
52 S (DIR("?"),DIR("??"))="^D YNDH^GMTSXAP2"
53 S DIR(0)="FAO^1;3^K:$$YNDI^GMTSXAP2(X)'>0 X",DIR("B")="Y"
54 D ^DIR S X=$$YNDO(X) S:X["^" GMTSEXIT=1 S:X="@" GMTSEXIT=1,GMTSCPL("@")=""
55 S:X="N"&($L(GMTSNEW))&(GMTSNEW=GMTSOLD) GMTSEXIT=1,GMTSCPL("@")=""
56 S X=$S(X="Y":1,X="N":0,1:-1)
57 Q
58YNDI(X) ; Input Transform
59 N GMTS S GMTS=$$UP^GMTSXA($G(X)) Q:$L(GMTS)&("^Y^YE^YES^N^NO^@^^^^^"'[("^"_GMTS_"^")) 0 Q 1
60YNDO(X) ; Output Transform
61 N GMTS S GMTS=$$UP^GMTSXA($G(X)) S X=$S($E(GMTS,1)="Y":"Y",$E(GMTS,1)="N":"N",$E(GMTS,1)="@":"@",GMTS["^^":"^^",1:"^")
62 S X=$S($D(DUOUT):"^",1:X),X=$S($D(DTOUT):"^^",$D(DIROUT):"^^",1:X) Q X
63YNDH ; Help
64 W !," Enter either 'Y'es, 'N'o, or '^' to exit" Q
65 Q
66 ;
67EDIT(GMTSUXR,X) ; Edit "Append/Overwrite"
68 N DIC,DIE,DTOUT,DUOUT,Y,DR,DA,GMTSACT,GMTSDAT,GMTSPREF,GMTSA
69 S GMTSDAT=$G(X),GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0
70 S GMTSPREF=$$PENT(GMTSUSR) Q:+GMTSPREF'>0
71 S DIE="^GMT(142.98,",DA=+($G(GMTSUSR)),DR="11///^S X=GMTSDAT"
72ED ; Lock Record, Edit Entry
73 L +^GMT(142.98,+GMTSPREF):0 I $T D ^DIE L -^GMT(142.98,+GMTSPREF) Q
74 S GMTSA=+($G(GMTSA))+1 Q:GMTSA>3 H 1 G ED
75 Q
76 ;
77 ; Deletions
78ADEL ; Ask for Deletion of Precedence
79 N X,Y,GMTSU,GMTSACT,GMTSDEF S GMTSU=$G(GMTSUSR),GMTSACT=$$ACTIVE^XUSER(+GMTSU) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)
80 Q:'$D(^GMT(142.98,+GMTSUSR,1)) S GMTSDEF=$P($G(^GMT(142.98,+GMTSUSR,1)),"^",2) Q:'$L(GMTSDEF)
81 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,GMTSA S DIR("B")="N",(GMTSA,DIR("A"))="Delete '"_GMTSDEF_"'? (Y/N) " S:$D(GMTSEL("@")) DIR("A")=" "_GMTSA S:$D(GMTSORD("@")) DIR("A")=" "_GMTSA
82 S:$D(GMTSCPL("@")) DIR("A")=" "_GMTSA K GMTSEL("@"),GMTSORD("@"),GMTSCPL("@")
83 S DIR(0)="YAO" W ! D ^DIR S:+Y>0 $P(^GMT(142.98,+GMTSUSR,1),"^",2)=""
84 Q
85DP(X) ; Delete Record of Inactive User
86 N DA,DIK,DIC,DTOUT,DUOUT,GMTSUSR S GMTSUSR=+($G(X))
87 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X)
88 S DIC="^GMT(142.98,",DIC(0)="M" D ^DIC I +Y>0 S DIK=DIC,DA=+Y D ^DIK
89 Q
90 ;
91 ; Miscellaneous
92OLD(X) ; Old Entry
93 Q $$GET1^DIQ(142.98,+($G(GMTSUSR)),11)
94ORT(X) ; Total Entities Ordered
95 N GMTSI S (X,GMTSI)=0 F S GMTSI=$O(GMTSORD(GMTSI)) Q:+GMTSI=0 S X=X+1
96 Q X
97SLT(X) ; Total Selected
98 N GMTSI S (X,GMTSI)=0 F S GMTSI=$O(GMTSEL(GMTSI)) Q:+GMTSI=0 S X=X+1
99 Q X
100PENT(GMTSUSR) ; Get User Preference Entry
101 N DIC,DTOUT,DUOUT,GMTSACT,DLAYGO S GMTSUSR=+($G(GMTSUSR)) Q:GMTSUSR=0 -1
102 S GMTSACT=$$ACTIVE^XUSER(+GMTSUSR) D:+GMTSACT'>0 DP(GMTSUSR) Q:+GMTSACT'>0 -1
103 S X=$$UNM^GMTSXAW3(+($G(GMTSUSR))) Q:'$L(X) -1
104 S DIC="^GMT(142.98,",DIC(0)="LM",DLAYGO=142.98 D ^DIC
105 S X=+($G(Y)) Q X
106PIT(X) ; Precedence Input Transform
107 N GMTSIN S GMTSIN=$$UP^GMTSXA($G(X)) Q:GMTSIN="" 1 N GMTSC,GMTSI,GMTSA,GMTS S GMTSC="^NAT^SYS^USR^",GMTS="" F GMTSI=1:1 Q:GMTSI>$L(GMTSIN,";") D
108 . S GMTSA=$P($G(GMTSIN),";",GMTSI) Q:$L(GMTSA)'=3 Q:GMTSC'[("^"_GMTSA_"^") Q:GMTS[(";"_GMTSA) S GMTS=GMTS_";"_GMTSA
109 S GMTS=$$TRIM^GMTSXA(GMTS,";",3),X=$S(GMTS=GMTSIN:1,1:0) Q X
110USRD(X) ; User Precedence/Default
111 N GMTSUSR S GMTSUSR=$G(X),X=$P($G(^GMT(142.98,+($G(GMTSUSR)),1)),"^",2)
112 S:X="" X=$$DEF^GMTSXAW(GMTSUSR) Q X
Note: See TracBrowser for help on using the repository browser.