source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RA84PRE.m@ 1150

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

initial load of WorldVistAEHR
File size: 11.9 KB
Line 
1RA84PRE ;Hines OI/GJC - Pre-init Driver, patch 84 ;01/05/06 06:32
2 ;;5.0;Radiology/Nuclear Medicine;**84**;Mar 16, 1998;Build 13
3 ;
4EN ; entry point for the pre-install logic
5 ;
6 ;Integration Agreements
7 ;----------------------
8 ;CREIXN^DDMOD(2916); DELIX^DDMOD(2916); $$FIND1^DIC(2051); UPDATE^DIE(2053); ^DIK(10013)
9 ;$$GET1^DIQ(2056); GETS^DIQ(2056); $$FMADD^XLFDT(10103); XMD(10070); BMES^XPDUTL(10141)
10 ;$$KSP^XUPARAM(2541); $$CREATE^XUSAP(4677)
11 ;
12 ;check to see if the following condition: RA*5.0*56 is not installed & BEFORE DELETION REPORT
13 ;STATUS (DD:74.01; Fld: 4) exists is true. If so, delete the BEFORE DELETION REPORT STATUS
14 ;field from the ACTIVITY LOG sub-file (exported accidentally; no data to be concerned with)
15 I '($$PATCH^XPDUTL("RA*5.0*56")),($D(^DD(74.01,4,0)))#2 D
16 .N %,DA,DIC,DIK,X,Y
17 .S DIK="^DD(74.01,",DA(1)=74.01,DA=4
18 .D ^DIK Q
19 ;
20 N DIERR,RAAPU,RAERR,RAFAC,RAFDA,RAFLD,RAFLG,RAFMC,RAIEN,RAOPT,RARY,RATXT,RAX,RAY,RAZ
21 S RAAPU="RADIOLOGY,OUTSIDE SERVICE",RAFMC="",RAOPT="RA OVERALL"
22 ;
23 ;I RAY>0 then the APU record was created; RAY will be the IEN of the new record.
24 ;I RAY=0 then the proxy user record existed prior to calling $$CREATE^XUSAP.
25 ;I RAY=-1 then the function failed to create the proxy user record.
26 S RAY=+$$CREATE^XUSAP(RAAPU,RAFMC,RAOPT)
27 ;
28 I RAY>0 S RAIEN=RAY,RATXT(1)="'"_RAAPU_"' has been created as an Application Proxy User."
29 ;
30 ;RAY=-1: The function failed to create the proxy user record; abort the install.
31 I RAY=-1 S XPDABORT=1 D
32 .S RATXT(1)="Error: '"_RAAPU_"' has not been created as an Application"
33 .S RATXT(2)="Proxy User. '"_RAAPU_"' must be unique"
34 .S RATXT(3)="and used within the scope of the VistA Radiology teleradiology"
35 .S RATXT(4)="initiative. Installation of RA*5.0*84 has been aborted until this"
36 .S RATXT(5)="Application Proxy User record can be created."
37 .Q
38 ;
39 ;RAY=0: The proxy user record existed prior to the function call. Is the proxy record
40 ;secure? If the proxy record is not secure abort the install.
41 I RAY=0 D
42 .;determine the IEN of 'RADIOLOGY,OUTSIDE SERVICE' in file 200...
43 .S RAIEN=$$FIND1^DIC(200,"","X","RADIOLOGY,OUTSIDE SERVICE","B") Q:RAIEN=0
44 .D GETS^DIQ(200,RAIEN_",","2;3;11;201","I","RARY") S RAFLD=""
45 .;Are there any NEW PERSON fields defined that jeopardize the security of this record?
46 .F S RAFLD=$O(RARY(200,RAIEN,RAFLD)) Q:RAFLD="" I $L($G(RARY(200,RAIEN,RAFLD,"I"))) S XPDABORT=1 Q
47 .I $G(XPDABORT)=1 D
48 ..S RATXT(1)="Error: '"_RAAPU_"' is not a secure application proxy user"
49 ..S RATXT(2)="record. Please revisit the definition of this type of user record."
50 ..S RATXT(3)=""
51 ..S RATXT(4)="Installation of RA*5.0*84 has been aborted until this Application Proxy"
52 ..S RATXT(5)="User record can be created."
53 ..Q
54 .Q
55 D BMES^XPDUTL(.RATXT)
56 Q:$G(XPDABORT)=1 K RATXT
57 ;
58 ;Add 'S' as a RAD/NUC MED CLASSIFICATION to the 'RADIOLOGY,OUTSIDE SERVICE' NEW PERSON file
59 ;record. Assign 'RADIOLOGY,OUTSIDE SERVICE' a PERSON CLASS.
60 ;permitted by IA 5077
61 I RAY'<0,(RAIEN>0) D
62 .K RARY S RAZ=RAIEN
63 .D GETS^DIQ(200,RAIEN_",","72*","I","RARY")
64 .I ($D(RARY)\10)=0 D ;'S' not added in the past; add now (missing "B" xref makes this tricky)
65 ..K DIERR,RAERR,RAFDA,RARY
66 ..S RAIEN="?+1,"_RAIEN_","
67 ..S RAFDA(200.072,RAIEN,.01)="S"
68 ..D UPDATE^DIE("","RAFDA","","RAERR")
69 ..;
70 ..;if error inform the user, proceed with filing PERSON CLASS
71 ..I ($D(RAERR("DIERR"))#2) S RAX="RAD/NUC MED CLASSIFICATION" D ERR
72 ..Q
73 .;
74 .;find the DIAGNOSTIC RADIOLOGY record in the PERSON CLASS (#8932.1) file.
75 .K DIERR,RAERR,RAFDA
76 .S RAPCLASS=$$PCLKUP() ;note workload encounter errors if the lookup fails
77 .I +RAPCLASS'>0 D Q
78 ..;cannot find desired record; inform the user & do not execute the PERSON CLASS update
79 ..S:+RAPCLASS=0 RATXT(1)="PERSON CLASS value DIAGNOSTIC RADIOLOGY' not found."
80 ..S:+RAPCLASS=-1 RATXT(1)="PERSON CLASS lookup error: "_$P(RAPCLASS,U,2)
81 ..S RATXT(2)="Encounter based workload calculations will fail until a PERSON CLASS is assigned."
82 ..D BMES^XPDUTL(.RATXT) K RATXT
83 ..Q
84 .;
85 .;file the PERSON CLASS value into PERSON CLASS sub-file: 200.05 IA 5077
86 .K DIERR,RAERR,RAFDA,RAY S RAIEN=RAZ
87 .S RAIEN="?+1,"_RAIEN_","
88 .S RAFDA(200.05,RAIEN,.01)=RAPCLASS
89 .S RAFDA(200.05,RAIEN,2)=$$FMADD^XLFDT(DT,-1,0,0,0) ;T-1 to make sure we work today!
90 .D UPDATE^DIE("","RAFDA","","RAERR")
91 .;
92 .;if error inform the user, proceed with install
93 .I ($D(RAERR("DIERR"))#2) S RAX="PERSON CLASS" D ERR
94 .Q
95 K DIERR,RAERR,RAFDA,RAY
96 ;
97 ;check to see if the facility has records within the 999-1003 IEN range within the
98 ;DIAGNOSTIC CODES (#78.3) file. If there are records with these IENs proceed with
99 ;the install but:
100 ;1) DO NOT alter (change pointers) the data in the DIAGNOSTIC CODES file at the facility
101 ;2) Send an email to an Outlook mail group identifying the facility where the
102 ; conflict occur.
103 ;If the IENs in this range are record free add them to the facilities' local DIAGNOSTIC CODES
104 ;file. RAFLG=1 when there is an existing record in the the IEN range of 999-1003
105 S RAFLG=0 F RAIEN=999:1:1003 I ($D(^RA(78.3,RAIEN,0))#2) S RAFLG=1 Q
106 ;
107 ;if RAFLG=1 send the email to the Outlook mail group
108 I RAFLG=1 D
109 .S RAFAC=$$GET1^DIQ(4,+$$KSP^XUPARAM("INST"),.01)
110 .N XMDUN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ S XMDUZ=.5
111 .S RATXT(1)=RAFAC_" has a conflict with national teleradiology codes"
112 .S RATXT(2)="diagnostic codes occupying IENS: 999-1003 in file 78.3."
113 .S XMSUB="DIAGNOSTIC CODES file IEN issue @ "_RAFAC,XMTEXT="RATXT("
114 .S XMY("VAOITVHITRadiologyFacilityLevelApplicationIssues@va.gov")=""
115 .NEW DIFROM
116 .D ^XMD,BMES^XPDUTL(.RATXT)
117 .Q
118 ;If no IEN conflict, add the nationally defined teleradiology diagnostic codes...
119 E D ;do-if RAFLG=0
120 .K RARY S RARY(999)="TELERADIOLOGY, NOT YET DICTATED^^N^n"
121 .S RARY(1000)="NO ALERT REQUIRED^^N^n"
122 .S RARY(1001)="SIGNIFICANT ABNORMALITY, ATTN NEEDED^^Y^y"
123 .S RARY(1002)="CRITICAL ABNORMALITY^^Y^y"
124 .S RARY(1003)="POSSIBLE MALIGNANCY^^Y^y",RAIEN=""
125 .F S RAIEN=$O(RARY(RAIEN)) Q:RAIEN="" D
126 ..S RAFDA(78.3,"+1,",.01)=$P(RARY(RAIEN),U,1)
127 ..S RAFDA(78.3,"+1,",3)=$P(RARY(RAIEN),U,3)
128 ..S RAFDA(78.3,"+1,",4)=$P(RARY(RAIEN),U,4)
129 ..S RAIEN(1)=RAIEN D UPDATE^DIE("","RAFDA","RAIEN","RAERR")
130 ..I $D(RAERR)#2 D
131 ...S RATXT(1)="",RATXT(2)="Error adding "_$P(RARY(RAIEN),U,1)_" to the"
132 ...S RATXT(3)="local DIAGNOSTIC CODES file #78.3." D BMES^XPDUTL(.RATXT)
133 ...Q
134 ..Q
135 .Q
136 ;
137 D XREF
138 Q
139 ;
140XREF ;REGARDLESS OF WHETHER FILE 78.3 HAS BEEN UPDATED, delete the traditional cross-reference
141 ;definition on the PRIMARY DIAGNOSTIC CODE (70.03,13) field. Params: sub-DD, field #,
142 ;cross-reference number, flag ('K' kills "AD"), array containing information about recompiled
143 ;templates &/or xrefs, error array dialog (if any)
144 ;
145 ;First check if the 'New Style' cross-reference is in place. If it is, quit this function now!
146 ;If in error, make sure the error is documented and proceed with the install of RA*5.0*84.
147 ;
148 N RAERR,RAVALUE,RAY S RAVALUE(1)=70,RAVALUE(2)="AD"
149 ;Note: "BB" (5th subscript) is the FILE & NAME cross-reference index in the INDEX (#.11) file.
150 S RAY=$$FIND1^DIC(.11,"","O",.RAVALUE,"BB","","RAERR")
151 I ($D(RAERR("DIERR")))#2 K RATXT D Q
152 .S RATXT(1)=$G(RAERR("DIERR",1,"TEXT",1),"Error finding the 'New Style' ""AD"" cross-reference.")
153 .D BMES^XPDUTL(.RATXT) K RATXT Q
154 ;
155 I RAY K RATXT D Q
156 .S RATXT(1)="The 'New Style' PRIMARY DIAGNOSTIC CODE (70.03, #13) ""AD"" cross-reference"
157 .S RATXT(2)="is currently in existence." D BMES^XPDUTL(.RATXT) K RATXT Q
158 ;
159 K DIERR,RAERR,RAFDA,RAIEN,RATXT
160 N I,RAI,RAMOWIC,RAX S RAY=0
161 ;find the old cross-reference to delete; set RAY to the record number of the cross-reference
162 F S RAY=$O(^DD(70.03,13,1,RAY)) Q:'RAY Q:$G(^DD(70.03,13,1,RAY,0))="70^AD^MUMPS"
163 ;RAY="" if there is no traditional "AD" cross-reference to delete, BUT make sure the
164 ;new style "AD" cross-reference is created ('D NS').
165 I RAY="" D NS Q
166 D DELIX^DDMOD(70.03,13,RAY,"K","RAMOWIC","RAERR")
167 S I=0 F RAX="DDAUD","DIEZ","DIKZ" D
168 .I ($D(RAMOWIC(RAX)))#2 D
169 ..S I=I+1,RATXT(I)=""
170 ..S:RAX="DDAUD" RATXT(I)="DD AUDIT (#.6) updated"
171 ..S:RAX="DIKZ" RATXT(I)="Cross-references re-compiled in namespace: "_$G(RAMOWIC(RAX)) QUIT
172 ..I RAX="DIEZ" S RAI=0 F S RAI=$O(RAMOWIC(RAX,RAI)) Q:'RAI D
173 ...S I=I+1,RATXT(I)="Input Template re-compiled: "_$G(RAMOWIC(RAX,RAI))
174 ...Q
175 ..Q
176 .Q
177 ;
178 ;Note: RAERR("DIERR") will only be defined if an error occurred...
179 I ($D(RAERR("DIERR")))#2 D S XPDABORT=1
180 .S I=I+1,RATXT(I)="",I=I+1
181 .S RATXT(I)="Error deleting the PRIMARY DIAGNOSTIC CODE (70.03,13) cross-reference."
182 .S I=I+1,RATXT(I)="Contact the national VistA Radiology development team."
183 .Q
184 D:$O(RATXT(0)) BMES^XPDUTL(.RATXT)
185 ;
186 ;if there is an error in deleting the old cross-reference stop the install of the patch.
187 Q:$G(XPDABORT)=1
188 ;
189NS ;Create the new-style cross-reference on the PRIMARY DIAGNOSTIC CODE (70.03,13) field.
190 ;This cross-reference will be named the same as the prior cross-reference, "AD", but
191 ;the SET & KILL logic will change. This new style cross-reference will be stored in the
192 ;INDEX (#.11) file.
193 N I,J,RAMOWIC,RARSLT,RAXREF K DIERR,RAERR,RATXT
194 S RAXREF("FILE")=70,RAXREF("TYPE")="MU",RAXREF("NAME")="AD"
195 S RAXREF("EXECUTION")="F",RAXREF("ROOT FILE")=70.03,RAXREF("USE")="S"
196 S RAXREF("ACTIVITY")="IR"
197 S RAXREF("SHORT DESCR")="The 'AD' is used to mark cases eligible for the Abnormal Report option."
198 S RAXREF("DESCR",1)="If the diagnostic code record in the radiology DIAGNOSTIC CODES (#78.3)"
199 S RAXREF("DESCR",2)="has the data attribute for field: PRINT ON ABNORMAL REPORT (#3) set to"
200 S RAXREF("DESCR",3)="'Y' (yes) then the ""AD"" cross-reference will be set for this exam record"
201 S RAXREF("DESCR",4)="to indicate that this case should be identified on the Abnormal Report."
202 S RAXREF("DESCR",5)=""
203 S RAXREF("DESCR",6)="NOTE: When this field is edited the DIAGNOSTIC PRINT DATE (#20) field is"
204 S RAXREF("DESCR",7)="deleted!",RAXREF("VAL",1)=13
205 S RAXREF("KILL CONDITION")="S:X1(1)'="""" X=1"
206 S RAXREF("KILL")="D:($D(X1(1))#2) PRIDXIXK^RADD2(.DA,X1(1))"
207 S RAXREF("SET CONDITION")="S:X2(1)'="""" X=1"
208 S RAXREF("SET")="S:$P($G(^RA(78.3,X2(1),0)),U,3)=""Y"" ^RADPT(""AD"",X2(1),DA(2),DA(1),DA)="""""
209 S RAXREF("WHOLE KILL")="K ^RADPT(""AD"")"
210 ;
211 D CREIXN^DDMOD(.RAXREF,"",.RARSLT,"RAMOWIC","RAERR") S I=1,RATXT(I)="",I=I+1
212 ;
213 S RATXT(I)="The '"_$P(RARSLT,U,2)_"' cross-reference was"_$S(RARSLT="":" not",1:"")_" successfully created."
214 ;
215 F J="DIEZ","DIKZ" D
216 .I J="DIEZ",($O(RAMOWIC("DIEZ",0))) D
217 ..N J1 S J1=0
218 ..F S J1=$O(RAMOWIC("DIEZ",J1)) Q:'J1 D
219 ...S I=I+1,RATXT(I)="Input template: "_$P($G(RAMOWIC("DIEZ",J1)),U)_" was re-compiled."
220 ...Q
221 ..Q
222 .;
223 .I J="DIKZ",$G(RAMOWIC("DIKZ"))'="" D
224 ..S I=I+1,RATXT(I)="Cross-reference re-compiled in namespace: "_$G(RAMOWIC("DIKZ"))
225 ..Q
226 .Q
227 ;
228 I ($D(RAERR("DIERR")))#2 D S XPDABORT=1
229 .S I=I+1,RATXT(I)="",I=I+1
230 .S RATXT(I)="Error deleting the PRIMARY DIAGNOSTIC CODE (70.03,13) cross-reference."
231 .S I=I+1,RATXT(I)="Contact the national VistA Radiology development team."
232 .Q
233 D:$O(RATXT(0)) BMES^XPDUTL(.RATXT)
234 Q
235 ;
236PCLKUP() ;PERSON CLASS lookup screened by INACTIVATED field on file 8932.1
237 ;If successful return the IEN.
238 ;If the lookup fails (without error) the function returns 0
239 ;If the lookup fails (with error) the function returns null w/error dialog
240 ; Ex: RAERR("DIERR","1","TEXT",1)="The input value contains control characters."
241 ; If error I'll return: -1^error dialog
242 N RAXEC S RAXEC="N RADT S RADT=$P(^(0),U,5) I $S('RADT:1,RADT>DT:1,1:0)"
243 S RASULT=$$FIND1^DIC(8932.1,"","X","V183002","F","X RAXEC","RAERR") ;"V183002"
244 Q $S(($D(RAERR("DIERR"))#2):"-1^"_$G(RAERR("DIERR","1","TEXT",1)),1:RASULT)
245 ;
246ERR ;display the error text associated with our failed event
247 ;input: RAX exists globally the attribute that was not filed Ex: RAD/NUC MED CLASSIFICATION
248 ; RAERR("DIERR") exists globally
249 K RATXT N RACNT,RAI,RAJ S RATXT(1)="APU record error when filing "_RAX_" data"
250 S RAI=0,RACNT=1
251 F S RAI=$O(RAERR("DIERR",RAI)) Q:RAI'>0 S RACNT=RACNT+1,RATXT(RACNT)="" D
252 .S RAJ=0 F S RAJ=$O(RAERR("DIERR",RAI,"TEXT",RAJ)) Q:RAJ'>0 D
253 ..Q:$G(RAERR("DIERR",RAI,"TEXT",RAJ))=""
254 ..S RACNT=RACNT+1,RATXT(RACNT)=$G(RAERR("DIERR",RAI,"TEXT",RAJ))
255 ..Q
256 .Q
257 D BMES^XPDUTL(.RATXT) K RATXT
258 Q
259 ;
Note: See TracBrowser for help on using the repository browser.