source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGFICLN.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.7 KB
Line 
1RGFICLN ;ALB/CJM-MPI/PD NDBI SITE CLEANUP UTILITY ;08/27/99
2 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;**9**;30 Apr 99
3 ;
4 ;Description:
5 ;Looks for patients that have the legacy site as a treating facilty or
6 ;as the CMOR and replaces it with the primary site.
7 ;
8 ;This utility can be executed in a test mode by setting the TESTMODE
9 ;input parameter to 1.
10 ;
11CLEAN(LEGACY,PRIMARY,TESTMODE,ERROR) ;
12 ;Input:
13 ; LEGACY - station # of legacy site
14 ; PRIMARY - station # of primary site
15 ; TESTMODE - set to 1 if this routine is to be run in interactive mode
16 ;Output:
17 ; Function Value: 1 on success, 0 on failure
18 ; ERROR: optional error msg returned on failure (pass by reference)
19 ; ** Also sends a report to the MPI EXCEPTIONS mailgroup
20 ;
21 ;Variables:
22 ; LEGACY("PTR"): ien of the legacy site in the Institution file
23 ; PRIMARY("PTR"): ien of the primary site in the institution file
24 ;
25 S TESTMODE=+$G(TESTMODE)
26 Q:'$$LOOKUP(.LEGACY,.PRIMARY,.ERROR) 0
27 D LOOP(.LEGACY,.PRIMARY)
28 Q 1
29 ;
30LOOKUP(LEGACY,PRIMARY,ERROR) ;
31 ;Does a lookup on the Institution file for the legacy and primary site
32 ;Input:
33 ; LEGACY - station # of legacy site
34 ; PRIMARY - station # of primary site
35 ;Output:
36 ; function value - 1 on success, 0 on faiure
37 ; LEGACY("PTR") - the ien (optional, pass LEGACY by reference)
38 ; PRIMARY("PTR") - the ien (optional, pass PRIMARY by reference)
39 ; ERROR - error message on failure (optional, pass by reference)
40 ;
41 S LEGACY("PTR")=$$LKUP^XUAF4($G(LEGACY))
42 I 'LEGACY("PTR") S ERROR="LEGACY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!" Q 0
43 S PRIMARY("PTR")=$$LKUP^XUAF4($G(PRIMARY))
44 I 'PRIMARY("PTR") S ERROR="PRIMARY STATION NUMBER NOT FOUND UNIQUELY IN THE INSTITUTION FILE!" Q 0
45 Q 1
46 ;
47LOOP(LEGACY,PRIMARY) ;
48 ;Description: Looks for patients having the Legacy site as the CMOR
49 ;or as a TF and for each such patient exchanges the legacy site with the
50 ;primary site.
51 ;
52 ;Input:
53 ; LEGACY(): as above
54 ; PRIMARY(): as above
55 ;Output:
56 ; MPI/NDBI SITE CLEANUP REPORT mailed to the MPI EXCEPTIONS mailgroup
57 ;VARIABLES:
58 ; RGREPORT - @RGREPORT will store interim results for the report
59 ; COUNT("TF") - count of patients found with legacy as TF
60 ; COUNT("CMOR") - count of patients found with legacy as CMOR
61 ; HERE - station # of the site this is running on
62 ; CMOR - patient's CMOR
63 ; CMOR("#") - station # of patient's CMOR
64 ;
65 N DFN,COUNT,RGREPORT,HERE
66 S RGREPORT="^TMP($J,""RG FACILITY INTEGRATION CLEANUP"")"
67 K @RGREPORT
68 S HERE=$P($$SITE^VASITE(),"^",3)
69 ;
70 ;don't do this if this is the legacy site
71 Q:(HERE=LEGACY)
72 ;
73 S (COUNT("TF"),COUNT("CMOR"),DFN)=0
74 I TESTMODE W !!,"Looking for patients with legacy site as CMOR ..."
75 F S DFN=$O(^DPT("ACMOR",LEGACY("PTR"),DFN)) Q:'DFN D I TESTMODE Q:'$$ASKYESNO^RGFIU("Another","YES")
76 .N CMOR
77 .S CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
78 .Q:(CMOR'=LEGACY("PTR"))
79 .I TESTMODE Q:'$$ASKOK(DFN)
80 .D PROC
81 .D CMORADD(RGREPORT,.COUNT,DFN)
82 ;
83 I TESTMODE W !!,"Looking for patients with legacy site as treating facility ..."
84 S DFN=0
85 F S DFN=$O(^DGCN(391.91,"AINST",LEGACY("PTR"),DFN)) Q:'DFN D I TESTMODE Q:'$$ASKYESNO^RGFIU("Another","YES")
86 .N CMOR
87 .I TESTMODE Q:'$$ASKOK(DFN)
88 .S CMOR=$$GETFIELD^RGFIU(2,991.03,DFN)
89 .D PROC
90 .D TFADD(RGREPORT,.COUNT,DFN)
91 I $G(TESTMODE) W !,"Returned mail message number:",$$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
92 I '$G(TESTMODE),$$REPORT(.COUNT,RGREPORT,LEGACY,PRIMARY)
93 K @RGREPORT
94 Q
95 ;
96PROC ;
97 N RES,ERROR,I
98 I '$$XCHANGE^RGFIPM(DFN,LEGACY,PRIMARY,.ERROR),TESTMODE W !,"** ERROR: ",$G(ERROR)
99 S CMOR("#")=$$STATNUM^RGFIU(CMOR)
100 I HERE=CMOR("#") D
101 .I TESTMODE D
102 ..I $$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR) W !,"HL7 Message sent: "
103 ..E W !,"*** HL7 Message NOT sent! :",$G(ERROR)
104 ..I $D(RES) S I=0 W !," Msg 1: ",RES F S I=$O(RES(I)) Q:'I W !," Msg ",(I+1),": ",RES(I)
105 .I 'TESTMODE,$$SEND^RGFIBM(DFN,LEGACY,PRIMARY,.RES,.ERROR)
106 Q
107 ;
108TFADD(RGREPORT,COUNT,DFN) ;
109 ;adds patient to list of legacy as TF
110 S COUNT("TF")=COUNT("TF")+1
111 S @RGREPORT@("TF",DFN)=""
112 Q
113 ;
114CMORADD(RGREPORT,COUNT,DFN) ;
115 ;adds patient to list of legacy as CMOR
116 ;
117 S COUNT("CMOR")=COUNT("CMOR")+1
118 S @RGREPORT@("CMOR",DFN)=""
119 Q
120 ;
121ASKOK(DFN) ;
122 ;Discription: Displays the CMOR and TF's for a single patient and asks whether to process
123 ;
124 ;Input:
125 ; DFN - patient that was just processed
126 ;Output:
127 ; Function value - 1 to quit, 0 to continue
128 ;Variables:
129 ; MPIDATA() - to contain the MPI data
130 ;
131 N SUB,MPIDATA
132 D GETALL^RGFIU(DFN,.MPIDATA)
133 W !!
134 W !,"Patient DFN: ",DFN
135 W !,"Patient Name: ",$$NAME^RGFIU(DFN)_" SSN: ",$$SSN^RGFIU(DFN)
136 W !,"Patient ICN: ",MPIDATA("ICN"),$S(MPIDATA("LOC"):" (local)",1:"")," CMOR: ",MPIDATA("CMOR")
137 ;
138 W !,"Treating Facilities:"
139 S SUB=0
140 F S SUB=$O(MPIDATA("TF",SUB)) Q:'SUB W !," ",SUB
141 ;
142 Q $$ASKYESNO^RGFIU("Process patient")
143 ;
144REPORT(COUNT,RGREPORT,LEGACY,PRIMARY) ;
145 ;Description: Mails report of cases found requiring cleanup after a site integration
146 ;
147 ;Input:
148 ; RGREPORT - @RGREPORT is the location of the report data
149 ; COUNT() - contains counts of patients cleaned up (pass by reference)
150 ; LEGACY - legacy site station #
151 ; PRIMARY - primary site station #
152 ;Output: none
153 ;
154 ;
155 N DFN,LINECNT
156 S (DFN,LINECNT)=0
157 K @RGREPORT@("MAILTEXT")
158 D HEADER
159 D ADDLINE("** Patients with Legacy Site as CMOR **")
160 D ADDLINE(" ")
161 F S DFN=$O(@RGREPORT@("CMOR",DFN)) Q:'DFN D
162 .D ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
163 D ADDLINE(" "),ADDLINE(" ")
164 D ADDLINE("** Patients with Legacy Site as Treating Facility **")
165 D ADDLINE(" ")
166 S DFN=0
167 F S DFN=$O(@RGREPORT@("TF",DFN)) Q:'DFN D
168 .D ADDLINE("Patient: "_$$LJ^XLFSTR($$NAME^RGFIU(DFN),30)_" SSN: "_$$SSN^RGFIU(DFN)_" ICN: "_$$ICN^RGFIU(DFN))
169 D ADDLINE(" "),ADDLINE("** END OF MPI/NDBI SITE CLEANUP REPORT **")
170 Q $$MAIL
171 ;
172HEADER ;
173 D ADDLINE("MPI/NDBI SITE CLEANUP REPORT FROM "_$P($$SITE^VASITE(),"^",2)_" DATE: "_$$FMTE^XLFDT(DT,"1"))
174 D ADDLINE("Primary Station: "_PRIMARY_" Legacy Station: "_LEGACY)
175 D ADDLINE("Count of Patients Found with Legacy Site as CMOR: "_COUNT("CMOR"))
176 D ADDLINE("Count of Patients Found with Legacy Site as Treating Facility: "_COUNT("TF"))
177 D ADDLINE(" ")
178 Q
179 ;
180ADDLINE(LINE) ;
181 ;Description: adds one one to the message text
182 ;Inputs:
183 ; LINE - the line of text to be added
184 ; RGREPORT - @RGREPORT is the location of the report
185 ; LINECNT - should be defined, the count of lines added to mail msg
186 S LINECNT=$G(LINECNT)+1
187 S @RGREPORT@("MAILTEXT",LINECNT)=LINE
188 Q
189MAIL() ;
190 N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,XMDUN,DIFROM
191 S XMY=.5
192 S XMDUZ="MPI/PD at "_$P($$SITE^VASITE(),"^",2)
193 I $G(DUZ) S XMY(DUZ)=""
194 S XMY("G.MPIF EXCEPTIONS")=""
195 S XMTEXT=$P(RGREPORT,")")_",""MAILTEXT"","
196 S XMSUB="MPI/NDBI SITE CLEANUP"
197 D ^XMD
198 Q $G(XMZ)
Note: See TracBrowser for help on using the repository browser.