source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPLE.m@ 1651

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1DGRPLE ;WAS/ERC/RMM,ALB/CKN - REGISTRATION EDITS OF PURPLE HEART FIELDS ; 9/29/05 4:53pm
2 ;;5.3;Registration;**314,343,377,431,653**;Aug 13, 1993;Build 2
3 ;
4DIV() ;Get Institution Name
5 ;If site is multi-divisional then ask user for division
6 ;
7 ; DBIA: #10112 - supported API $$SITE^VASITE and $$PRIM^VASITE
8 ; for retrieving Institution name
9 ;
10 ; Input: none
11 ;
12 ; Output: DGNAM - Institution name
13 ;
14 N DGDIV,DGSTN,DGNAM
15 S DGDIV=$S($D(^DG(40.8,"B")):$$MULTDIV,1:$$PRIM^VASITE)
16 S DGSTN=$$SITE^VASITE(,DGDIV)
17 S DGNAM=$S($P(DGSTN,U,2)]"":$P(DGSTN,U,2),1:"")
18 Q DGNAM
19 ;
20MULTDIV() ;User selects from active divisions
21 ;
22 ; Input: none
23 ;
24 ; Output:
25 ; Function return value - Division IEN
26 ;
27 N DIR,X,Y
28 S DIR(0)="PA^40.8:EM"
29 S DIR("A")="Enter your division: "
30 S DIR("S")="I $$SITE^VASITE(,+Y)>0"
31 D ^DIR
32 Q +Y
33 ;
34EDITPOW(DG1,DG2,DG3,DG4,DGDFN) ;entry from enrollment for HEC updates
35 ; DGDFN - Patient File IEN
36 ; DG1 - POW Indicator
37 ; DG2 - POW Confinement Location
38 ; DG3 - POW From Date
39 ; DG4 - POW To Date
40 ; Update POW data from HEC - DG*5.3*653
41 N DATA,DGENDA,ERROR,CURPOW,POW
42 S DGENDA=DGDFN
43 S CURPOW=$G(^DPT(DGDFN,.52))
44 S POW(.525)=$P(CURPOW,"^",5) ;Current POW indicator
45 ;add following code for EVC R2
46 ;S POW(.529)=$P(CURPOW,"^",9) ;Current POW verified status
47 S DATA(.525)=$G(DG1)
48 ;add following commented line for EVC R2
49 ;If Current POW Verified Status is null,
50 ;OR Current POW Verified Status is not null and incoming POW indicator is different than current POW indicator,
51 ;set POW Verified Status to current Date/Time.
52 ;I (POW(.529)="")!((POW(.529)'="")&(DG1'=POW(.525))) S DATA(.529)=$$NOW^XLFDT()
53 ;Remove the values in database if POW Indicator is NO
54 ;otherwise update new values
55 S DATA(.526)=$S(DG1="N":"@",1:DG2)
56 S DATA(.527)=$S(DG1="N":"@",1:DG3)
57 S DATA(.528)=$S(DG1="N":"@",1:DG4)
58 I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
59 . D ADDMSG^DGENUPL3(.MSGS,"Unable to update POW Data.",1)
60 K DATA,DGENDA,ERROR,DG1,DG2,DG3,DG4
61 Q
62 ;
63EDITPH(DG1,DG2,DG3,DGDFN) ;entry from enrollment for HEC updates
64 ; DGDFN - Patient File IEN
65 ; DG1 - PH Indicator
66 ; DG2 - PH Status
67 ; DG3 - PH Remarks
68 ;
69 N DATA,DGENDA,ERROR,DGUSER,DGPHARR,%
70 S DGENDA=DGDFN
71 S (DG(1),DATA(.531))=DG1
72 S (DG(2),DATA(.532))=$S(DG1="N":"",1:DG2)
73 S (DG(3),DATA(.533))=$S(DG1="Y":"",1:DG3)
74 I '$$UPD^DGENDBS(2,.DGENDA,.DATA,.ERROR) D
75 .D ADDMSG^DGENUPL3(.MSGS,"Unable to update Purple Heart Data.",1)
76 K DATA,DGENDA,ERROR
77 ; If the Database Server Failed, Quit.
78 Q:'$D(^DPT(DGDFN,.53))
79 S DGUSER="HEC User",DGPHARR=^DPT(DGDFN,.53)
80 ; If nothing was changed, don't update the history, Quit.
81 Q:'$$CHANGE(DG(1),DG(2),DG(3),DGDFN)
82 ;
83 D NOW^%DTC
84 S DATA(.01)=%,DATA(1)=DG(1),DATA(2)=DG(2),DATA(3)=DG(3)
85 S DATA(4)=DGUSER,DGENDA(1)=DGDFN
86 I '$$ADD^DGENDBS(2.0534,.DGENDA,.DATA,.ERROR) D
87 .D ADDMSG^DGENUPL3(.MSGS,"Unable to update Purple Heart History.",1)
88 K DATA,DGENDA,ERROR
89 ;
90 Q
91 ;
92EDITPH1(DGUSER) ;
93 ; Input: DGUSER - Person filing Purple Heart changes
94 ;
95 ; Output: none
96 ;
97 S DGUSER=$G(DGUSER,$P(^VA(200,DUZ,0),U))
98 NEW DGPHARR,DG,DGX
99 S DGPHARR=^DPT(DFN,.53)
100 ;REDIE will ensure there is a STATUS only if indicator is
101 ;'yes' and a REMARK only if indicator is 'no'
102 I $P(DGPHARR,U)="Y",($P(DGPHARR,U,3)]"") D REDIE(3)
103 I $P(DGPHARR,U)="N",($P(DGPHARR,U,2)]"") D REDIE(2)
104 F DGX=1:1:3 S DG(DGX)=$P(DGPHARR,U,DGX)
105 I $$CHANGE(DG(1),DG(2),DG(3),DFN) D EDITPH2(DG(1),DG(2),DG(3),DGUSER)
106 Q
107 ;
108EDITPH2(DG1,DG2,DG3,DG4) ;stuff PH values into the PH multiple of file #2
109 S DFN=DA
110 N DA,DIC,DIE
111 S DIC="^DPT("_DFN_",""PH"","
112 S DA(1)=DFN
113 D NOW^%DTC S X=%
114 S DIC(0)="L"
115 S DIC("DR")="1///^S X=$G(DG1);2///^S X=$G(DG2);3///^S X=$G(DG3);4///^S X=$G(DG4)"
116 D ^DIC
117 Q
118 ;
119REDIE(DGPCE) ; make sure value in PH Status and PH Remarks consistent
120 ; with value of PH Indicator
121 N DA,DIE,DR
122 S DIE="^DPT(",DR=$S($G(DGPCE)=2:.532,1:.533)_"///^S X=""@"""
123 S DA=DFN
124 D ^DIE
125 S DGPHARR=^DPT(DFN,.53)
126 Q
127 ;
128CHANGE(DGPH1,DGPH2,DGPH3,DGPHDFN) ;Check to see if the entry has changed
129 ; Input:
130 ; DGPH1 - PH Indicator
131 ; DGPH2 - PH Status
132 ; DGPH3 - PH Remarks
133 ; DGPHDFN- Patient file IEN
134 ;
135 ; Output: none
136 ;
137 ; Return: DGCHG = 1 - Change in any of the input values has occurred
138 ; DGCHG = 0 - No change
139 ;
140 N DGCHG ;Return value
141 N DGARR ;Array containing last values from audit
142 N DGPHVAL ;Merged array of DGARR
143 N DGERR ;Error root for DIQ
144 N DGIEN ;IEN of last audit value
145 N DGFILE ;Purple Heart Multiple
146 N DGI ;Index counter
147 ;
148 K DGPHINC
149 S DGCHG=0
150 S DGFILE=2.0534
151 S DGIEN=$O(^DPT(DGPHDFN,"PH","B"),-1)
152 I DGIEN="" S DGCHG=1 G AUDITQ
153 D GETS^DIQ(DGFILE,DGIEN_","_DGPHDFN_",","1;2;3","I","DGARR","DGERR")
154 I $D(DGERR) S DGCHG=1 G AUDITQ
155 M DGPHVAL=DGARR(DGFILE,DGIEN_","_DGPHDFN_",")
156 F DGI=1:1:3 I @("DGPH"_DGI)'=DGPHVAL(DGI,"I") D
157 . S DGCHG=1
158 . I DGI=1 D ; PH INDICATOR has changed
159 . . I DGPH1="N",DGPHVAL(DGI,"I")="Y" S DGPHINC=1 ; Package Variable to note PH Indicator has changed
160AUDITQ Q DGCHG
Note: See TracBrowser for help on using the repository browser.