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

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

initial load of WorldVistAEHR
File size: 7.1 KB
RevLine 
[613]1DGENUPA1 ;ALB/CJM - UPLOAD AUDIT ; 04-APR-94
2 ;;5.3;REGISTRATION;**147,222,232**;Aug 13,1993
3 ;
4AUDIT(ERROR,MSGID,OLDPAT,NEWPAT,OLDELG,NEWELG,OLDCDIS,NEWCDIS,NEWSEC,OLDSEC) ;
5 ;Description: creates an audit trail for an upload.
6 ;
7 ;Input:
8 ;Output:
9 ; Function Value: 1 on sucess, 0 on failure
10 ; ERROR - error message (optional, pass by reference)
11 N AUDIT
12 D CREATE^DGENUPA(OLDPAT("DFN"),,MSGID,.AUDIT)
13 D PAT
14 D ELIG
15 D ELGCODES
16 D RDISB
17 D CDIS
18 D SEC
19 Q +$$STORE^DGENUPA(.AUDIT,.ERROR)
20 ;
21ELIG ;
22 ;Description: Changes for Eligibility object (other than multiples)
23 N FIELD,LINE,IEN,HDR
24 S HDR=0
25 I OLDELG("ELIG","CODE")'=NEWELG("ELIG","CODE") D
26 .;
27 .S LINE=$$LJ^XLFSTR("PRIMRY ELIG: ",15)_$$LJ^XLFSTR($$EXT^DGENELA3("CODE",OLDELG("ELIG","CODE")),33)_" "_$$EXT^DGENELA3("CODE",NEWELG("ELIG","CODE"))
28 .I 'HDR D ELGHDR
29 .D ADDCHNG^DGENUPA(.AUDIT,LINE)
30 ;
31 S FIELD=""
32 F S FIELD=$O(OLDELG(FIELD)) Q:(FIELD="") D
33 .Q:((FIELD="ELIG")!(FIELD="RATEDIS")!(FIELD="MTSTA")!(FIELD="DFN")) ;MT Status not uploaded
34 .I OLDELG(FIELD)'=NEWELG(FIELD) D
35 ..;
36 ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENELA3(FIELD,OLDELG(FIELD)),33)_" "_$$EXT^DGENELA3(FIELD,NEWELG(FIELD))
37 ..I 'HDR D ELGHDR
38 ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
39 Q
40 ;
41ELGHDR ;
42 ;Description: Header for changes in ELIGIBILITY object
43 ;
44 D ADDCHNG^DGENUPA(.AUDIT," ")
45 D ADDCHNG^DGENUPA(.AUDIT," Patient Eligibility")
46 D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
47 D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
48 S HDR=1
49 Q
50 ;
51ELGCODES ;
52 ;Description: Changes in Patient Eligibilities
53 ;
54 N FIELD,LINE,IEN,HDR
55 S HDR=0
56 S IEN=0
57 F S IEN=$O(NEWELG("ELIG","CODE",IEN)) Q:'IEN I '$G(OLDELG("ELIG","CODE",IEN)) D
58 .D:'HDR AELGHDR
59 .D ADDCHNG^DGENUPA(.AUDIT," "_$$EXT^DGENELA3("CODE",IEN))
60 ;
61 S HDR=0
62 S IEN=0
63 F S IEN=$O(OLDELG("ELIG","CODE",IEN)) Q:'IEN I '$G(NEWELG("ELIG","CODE",IEN)) D
64 .;
65 .;the new primary eligibility code will be placed in the eligibilities multiple via the x-ref
66 .Q:(OLDELG("ELIG","CODE",IEN)=NEWELG("ELIG","CODE"))
67 .;
68 .D:'HDR DELGHDR
69 .D ADDCHNG^DGENUPA(.AUDIT," "_$$EXT^DGENELA3("CODE",IEN))
70 ;
71 Q
72 ;
73AELGHDR ;
74 ;Description: Header for eligibility codes added
75 ;
76 D ADDCHNG^DGENUPA(.AUDIT," ")
77 D ADDCHNG^DGENUPA(.AUDIT,"Patient Eligibilities Added:")
78 S HDR=1
79 Q
80 ;
81DELGHDR ;
82 ;Description: Header for eligibility codes deleted
83 ;
84 D ADDCHNG^DGENUPA(.AUDIT," ")
85 D ADDCHNG^DGENUPA(.AUDIT,"Patient Eligibilities Deleted:")
86 S HDR=1
87 Q
88 ;
89RDISB ;
90 ;Description: Changes in Rated Disabilities
91 ;
92 N COUNT,NEWDIBS,OLDDIBS,IEN,PER,SC,HDR
93 ;set up the rated disabilities in a more useful format to detect changes
94 S COUNT=0
95 F S COUNT=$O(NEWELG("RATEDIS",COUNT)) Q:'COUNT S NEWDIBS(+NEWELG("RATEDIS",COUNT,"RD"),+NEWELG("RATEDIS",COUNT,"PER"),$J(NEWELG("RATEDIS",COUNT,"RDSC"),1))=""
96 S COUNT=0
97 F S COUNT=$O(OLDELG("RATEDIS",COUNT)) Q:'COUNT S OLDDIBS(+OLDELG("RATEDIS",COUNT,"RD"),+OLDELG("RATEDIS",COUNT,"PER"),$J(OLDELG("RATEDIS",COUNT,"RDSC"),1))=""
98 ;
99 ;find disabilty taht have been added
100 S HDR=0
101 S IEN=0
102 F S IEN=$O(NEWDIBS(IEN)) Q:'IEN D
103 .S PER=""
104 .F S PER=$O(NEWDIBS(IEN,PER)) Q:(PER="") D
105 ..S SC=""
106 ..F S SC=$O(NEWDIBS(IEN,PER,SC)) Q:(SC="") D
107 ...I '$D(OLDDIBS(IEN,PER,SC)) D
108 ....D:'HDR ARDISHDR
109 ....D ADDCHNG^DGENUPA(.AUDIT," "_$$LJ^XLFSTR($$EXT^DGENELA3("RD",IEN),45)_" Percent: "_PER_" SC: "_$$EXT^DGENELA3("RDSC",SC))
110 ;
111 ;find disabilities that have been deleted
112 S HDR=0
113 S IEN=0
114 F S IEN=$O(OLDDIBS(IEN)) Q:'IEN D
115 .S PER=""
116 .F S PER=$O(OLDDIBS(IEN,PER)) Q:(PER="") D
117 ..S SC=""
118 ..F S SC=$O(OLDDIBS(IEN,PER,SC)) Q:(SC="") D
119 ...I '$D(NEWDIBS(IEN,PER,SC)) D
120 ....D:'HDR DRDISHDR
121 ....D ADDCHNG^DGENUPA(.AUDIT," "_$$LJ^XLFSTR($$EXT^DGENELA3("RD",IEN),45)_" Percent: "_PER_" SC: "_$$EXT^DGENELA3("RDSC",SC))
122 Q
123 ;
124DRDISHDR ;
125 ;Description: Header for deleted disabilities
126 ;
127 D ADDCHNG^DGENUPA(.AUDIT," ")
128 D ADDCHNG^DGENUPA(.AUDIT,"Rated Disabilities Deleted:")
129 S HDR=1
130 Q
131 ;
132ARDISHDR ;
133 ;Description: Header for added disabilities
134 ;
135 D ADDCHNG^DGENUPA(.AUDIT," ")
136 D ADDCHNG^DGENUPA(.AUDIT,"Rated Disabilities Added:")
137 S HDR=1
138 Q
139 ;
140PAT ;
141 ;Description: Changes in PATIENT object
142 ;
143 N FIELD,LINE,IEN,HDR
144 S HDR=0
145 S FIELD=""
146 F S FIELD=$O(OLDPAT(FIELD)) Q:(FIELD="") D
147 .Q:((FIELD="DFN")) ;
148 .I OLDPAT(FIELD)'=NEWPAT(FIELD) D
149 ..;
150 ..I 'HDR D PATHDR
151 ..I FIELD="DEATH" S LINE="** ALERT ONLY: Changes to Date of Death are NOT automatically updated **" D ADDCHNG^DGENUPA(.AUDIT,LINE)
152 ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENPTA(FIELD,OLDPAT(FIELD)),33)_" "_$$EXT^DGENPTA(FIELD,NEWPAT(FIELD))
153 ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
154 Q
155 ;
156PATHDR ;
157 ;Descripition: Header for changes in PATIENT object
158 ;
159 D ADDCHNG^DGENUPA(.AUDIT," Patient Demographics")
160 D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
161 D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
162 S HDR=1
163 Q
164 ;
165CDIS ;
166 ;Description: Changes in CATASTROPHIC DISABILTY object
167 ;
168 N SUBFIELD,FIELD,LINE,IEN,HDR
169 S HDR=0
170 S FIELD=""
171 F S FIELD=$O(OLDCDIS(FIELD)) Q:(FIELD="") D
172 .I $D(OLDCDIS(FIELD))'=1 Q
173 .I OLDCDIS(FIELD)'=NEWCDIS(FIELD) D
174 ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENCDU(FIELD,OLDCDIS(FIELD)),33)_" "_$$EXT^DGENCDU(FIELD,NEWCDIS(FIELD))
175 ..I 'HDR D CDISHDR
176 ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
177 F FIELD="SCORE","PROC","PERM","EXT","DIAG","COND" D
178 .F SUBFIELD=1:1 Q:('$D(OLDCDIS(FIELD,SUBFIELD)))&('$D(NEWCDIS(FIELD,SUBFIELD))) D
179 ..I $G(OLDCDIS(FIELD,SUBFIELD))'=$G(NEWCDIS(FIELD,SUBFIELD)) D
180 ...S LINE=$$LJ^XLFSTR(FIELD_": ",15)
181 ...S LINE=LINE_$$LJ^XLFSTR($S($G(OLDCDIS(FIELD,SUBFIELD))'="":$$EXT^DGENCDU(FIELD,OLDCDIS(FIELD,SUBFIELD)),1:""),33)
182 ...S LINE=LINE_" "_$S($G(NEWCDIS(FIELD,SUBFIELD))'="":$$EXT^DGENCDU(FIELD,NEWCDIS(FIELD,SUBFIELD)),1:"")
183 ...I 'HDR D CDISHDR
184 ...D ADDCHNG^DGENUPA(.AUDIT,LINE)
185 Q
186 ;
187CDISHDR ;
188 ;Descripition: Header for changes in CATASTROPHIC DISABILTY object
189 ;
190 D ADDCHNG^DGENUPA(.AUDIT," ")
191 D ADDCHNG^DGENUPA(.AUDIT," Catastrophic Disability")
192 D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
193 D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
194 S HDR=1
195 Q
196 ;
197SEC ;
198 ; Description: Changes in PATIENT SECURITY object
199 ;
200 N FIELD,LINE,IEN,HDR
201 S HDR=0
202 S FIELD=""
203 F S FIELD=$O(OLDSEC(FIELD)) Q:(FIELD="") D
204 .;
205 .Q:((FIELD="DFN")) ; do not need to audit this field
206 .I OLDSEC(FIELD)'=NEWSEC(FIELD) D
207 ..;
208 ..S LINE=$$LJ^XLFSTR(FIELD_": ",15)_$$LJ^XLFSTR($$EXT^DGENSEC(FIELD,OLDSEC(FIELD)),33)_" "_$$EXT^DGENSEC(FIELD,NEWSEC(FIELD))
209 ..I 'HDR D SECHDR
210 ..D ADDCHNG^DGENUPA(.AUDIT,LINE)
211 ;
212 Q
213 ;
214SECHDR ;
215 ; Description: Header for changes in PATIENT SECURITY object
216 ;
217 D ADDCHNG^DGENUPA(.AUDIT," ")
218 D ADDCHNG^DGENUPA(.AUDIT," Patient Security")
219 D ADDCHNG^DGENUPA(.AUDIT,"Field Before After")
220 D ADDCHNG^DGENUPA(.AUDIT,"=============================================================================")
221 S HDR=1
222 Q
Note: See TracBrowser for help on using the repository browser.