source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53244U.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: 9.0 KB
Line 
1DG53244U ;ALB/JDS,BPOIFO/KEITH - Patient Name Standardization ; 27 Jan 2002 11:55 PM
2 ;;5.3;Registration;**244,620**;Aug 13, 1993
3 ;Adapted from XLFNAME3 MKO
4RUN(DGFLAG) ;Convert PATIENT file names;
5 ;In: DGFLAG [ "U" : Quit, use existing global
6 ; [ "K" : Kill ^XTMP. generate global
7 ; [ "P" : Kill ^XTMP, update names, generate global
8 ;
9 ;Use existing global to print
10 Q:DGFLAG="U"
11 ;
12 N DGIENS,DGNAM,DGNMSP,DGPVAL,DPTINV,DGQ,DGTOTAL,DGOUT,DGNCMG,DGNOFDEL
13 N DGA,DGI,DPTFIL,DPTFLD,DPTIENS,DGFIELD,DGTYPE,DPTA,DPTI,VAFHCA08,DGZ
14 N DPTVALUE,DGTEXT,VAFCA08,VAFCNO,DGENUPLD,DPTFN,DGPRUN,DGXRARY,DGMPI
15 N DGICN
16 ;Initialize variables
17 S DGNMSP="DPTNAME",DGQ="""",DGOUT=0
18 F DGI=1:1 S DGA=$T(FIELD+DGI) Q:(DGA'[";;") D
19 .S DGFIELD(DGI,$P($P(DGA,";;",2),U,3))=$P(DGA,";;",2) Q
20 D XRARY^DG53244V
21 ;Set up ^XTMP
22 I '$G(^XTMP(DGNMSP,0,0)) D
23 .K ^XTMP(DGNMSP)
24 .S ^XTMP(DGNMSP,0)=$$FMADD^XLFDT(DT,90)_"^"_DT
25 .I DGFLAG="P" D
26 ..S ^XTMP(DGNMSP,0,0)=$$NOW^XLFDT(),$P(^XTMP(DGNMSP,0),U,4)=0
27 ..S $P(^XTMP(DGNMSP,0),U,3)="Perform Name Conversion"
28 ..Q
29 .I DGFLAG="K" S $P(^XTMP(DGNMSP,0),U,3)="Generate Report Data"
30 .I '$D(^XTMP(DGNMSP,"STATS")) D
31 ..S $P(^XTMP(DGNMSP,"STATS",2,.01),U,7)="Patient name"
32 ..S $P(^XTMP(DGNMSP,"STATS",2,.211),U,7)="Primary NOK name"
33 ..S $P(^XTMP(DGNMSP,"STATS",2,.2191),U,7)="Secondary NOK name"
34 ..S $P(^XTMP(DGNMSP,"STATS",2,.2401),U,7)="Father's name"
35 ..S $P(^XTMP(DGNMSP,"STATS",2,.2402),U,7)="Mother's name"
36 ..S $P(^XTMP(DGNMSP,"STATS",2,.2403),U,7)="Mother's maiden name"
37 ..S $P(^XTMP(DGNMSP,"STATS",2,.331),U,7)="Prim. E-contact name"
38 ..S $P(^XTMP(DGNMSP,"STATS",2,.3311),U,7)="2nd E-contact name"
39 ..S $P(^XTMP(DGNMSP,"STATS",2,.341),U,7)="Designee name"
40 ..S $P(^XTMP(DGNMSP,"STATS",2.01,.01),U,7)="Alias name"
41 ..S $P(^XTMP(DGNMSP,"STATS",2.101,30),U,7)="Attorney's name"
42 I DGFLAG="P" D
43 .S $P(^XTMP(DGNMSP,0),U)=$$FMADD^XLFDT(DT,90)
44 .S $P(^XTMP(DGNMSP,0),U,5)="RUN"
45 .S DGPRUN=$O(^XTMP(DGNMSP,0,""),-1)+1
46 .S ^XTMP(DGNMSP,0,DGPRUN)=$$NOW^XLFDT()_"^^"_+$P($G(^XTMP(DGNMSP,"STATS")),U)
47 .D MGOUT^DG53244T(.DGNCMG) ;Remove name change mail group
48 .Q
49 ;
50 ;Prevent messages to HEC
51 S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"
52 S VAFCNO=1 ;Prevent MPI messages
53 S (VAFCA08,VAFHCA08)=1 ;Prevent PIMS Generic Messaging
54 S DGNOFDEL=1 ;Prevent deletion of contact address fields
55 ;
56LOOP ;Loop through Patient file
57 S DGIEN=+$P(^XTMP(DGNMSP,0),U,4)
58 F S DGIEN=$O(^DPT(DGIEN)) Q:'DGIEN!$$LAST() D
59 .;Skip merging patients
60 .Q:$P($G(^DPT(DGIEN,0)),U)["MERGING INTO"
61 .;Skip patients that have been merged to another record
62 .Q:$D(^DPT(DGIEN,-9))
63 .;Evaluate field values
64 .S DGIENS=DGIEN_",",DGMPI=0
65 .S DGZ=0 F S DGZ=$O(DGFIELD(DGZ)) Q:'DGZ D
66 ..S DPTA="" F S DPTA=$O(DGFIELD(DGZ,DPTA)) Q:DPTA="" D
67 ...Q:'$D(^DPT(DGIEN,$P(DPTA,";")))
68 ...S DGTYPE=DGFIELD(DGZ,DPTA),DPTFLD=$P(DGTYPE,U,2)
69 ...S DPTMAX=$P(DGTYPE,U,5) S:'DPTMAX DPTMAX=35
70 ...I $L(DPTA,";")=3 D Q
71 ....F DPTI=0:0 S DPTI=$O(^DPT(DGIEN,$P(DPTA,";"),DPTI)) Q:'DPTI D
72 .....S DPTIENS=DGIEN_","_DPTI_",",DPTFIL=$P(DGTYPE,U,6)
73 .....S DPTVALUE=$P($G(^DPT(DGIEN,$P(DPTA,";"),DPTI,$P(DPTA,";",2))),U,$P(DPTA,";",3))
74 .....Q:'$L(DPTVALUE)
75 .....D UPDATE(DGFLAG,DPTFIL,DPTIENS,DPTFLD,DPTVALUE,DGNMSP,DPTMAX,DPTA)
76 ...S DPTIENS=DGIEN_",",DPTFIL=2
77 ...S DPTVALUE=$P($G(^DPT(DGIEN,$P(DPTA,";"))),U,$P(DPTA,";",2))
78 ...Q:'$L(DPTVALUE)
79 ...D UPDATE(DGFLAG,DPTFIL,DPTIENS,DPTFLD,DPTVALUE,DGNMSP,DPTMAX,DPTA,.DGMPI)
80 ..S $P(^XTMP(DGNMSP,0),U,4)=DGIEN
81 .I DGMPI D ;Send MPI message
82 ..D RMPI(1) S DGICN=$$GETICN^MPIF001(DGIEN)
83 ..;No ICN, don't send message
84 ..I +DGICN=-1 S DGICN=0 D RMPI(2)
85 ..;Local ICN, don't send message
86 ..I $P($$SITE^VASITE(),"^",3)=$E(DGICN,1,3) S DGICN=0 D RMPI(3)
87 ..I DGICN'=0 N X S X="MPIFA31B" X ^%ZOSF("TEST") D RMPI(4) I $T S DGMPI=$$A31^MPIFA31B(DGIEN) D RMPI(5,DGMPI)
88 ..;Log exception to MPI if problem generating ICN
89 ..I +DGMPI=-1 D RMPI(6),START^RGHLLOG(),EXC^RGHLLOG(220,"Problem generating A31 "_$P(DGMPI,"^",2),DGIEN),STOP^RGHLLOG()
90 ;Send notification message
91 Q:DGFLAG'="P"
92 D MGIN^DG53244T(DGNCMG) ;Replace name change mail group
93 I 'DGIEN,'DGOUT S $P(^XTMP(DGNMSP,0,0),U,2)=$$NOW^XLFDT()
94 S $P(^XTMP(DGNMSP,0,DGPRUN),U,2)=$$NOW^XLFDT()
95 S $P(^XTMP(DGNMSP,0,DGPRUN),U,4)=+$P(^XTMP(DGNMSP,"STATS"),U)
96 S $P(^XTMP(DGNMSP,0),U,5)="STOP"
97MSG K DGTEXT
98 N XMY,XMTEXT,XMDUN,XMDUZ,XMSUB,XMZ,DGLINE
99 S DGLINE="",$P(DGLINE,"-",80)=""
100 S XMSUB="Patient Name Conversion Process"
101 S XMY("G.PMSTRACK@FORUM.VA.GOV")=""
102 S XMY(+$G(DUZ))="",(XMDUN,XMDUZ)="Patch DG*5.3*244"
103 S DGTEXT(1,0)="The Patient Name Standardization conversion has completed" S DGTEXT=1
104 I DGOUT D
105 .S DGTEXT(1,0)="The Patient Name Standardization was Stopped"
106 .S DGTEXT(2,0)="Please remember to complete the patient name conversion in the future."
107 .S DGTEXT=2
108 S DGOUT=0 D STATS^DG53244V(.DGTEXT)
109 S XMTEXT="DGTEXT("
110 D ^XMD
111 Q
112 ;
113UPDATE(DGFLAG,DGFIL,DGIENS,DGFLD,DGNAM,DGNMSP,DPTMAX,DPTA,DGMPI) ;Process name field
114 ;
115 N DGAUD,DGFDA,DGMSG,DIERR,DGOLD
116 ;Total names evaluated
117 S $P(^XTMP(DGNMSP,"STATS"),U)=$P($G(^XTMP(DGNMSP,"STATS")),U)+1
118 ;Total evaluated by field
119 S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U)=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U)+1
120 ;Format name
121 S DGOLD=$G(DGNAM)
122 S DGNAM=$$FORMAT^XLFNAME7(.DGNAM,3,DPTMAX,,2,.DGAUD,$S(DGFLD=.2403:1,1:0))
123 D:(DGAUD'=0) RECORD(DGFIL,DGFLD,DGIENS,DGNAM,.DGAUD,DGNMSP,DGIEN,DGOLD)
124 Q:DGFLAG'="P" ;Processing only
125 Q:DGAUD=2 ;Unconvertible
126 ;Update components if name is not changed
127 I DGAUD=0 D Q
128 .N DGI,DA,X,DG20NAME,XUNOTRIG
129 .F DGI=2.1,1.1 D
130 ..S:(DGFIL=2) DA=DGIEN S:(DGFIL'=2) DA(1)=DGIEN,DA=$P(DGIENS,",",2)
131 ..S X=DGNAM X DGXRARY($P(DGFIELD(DGZ,DPTA),U,7),DGI)
132 ..Q
133 .Q
134 ;Update source name if different
135 S DPTINV=$TR($$INV(DGIENS),":",",")_","
136 S DGFDA(DGFIL,DPTINV,DGFLD)=DGNAM
137 D FILE^DIE("","DGFDA","DGMSG") K DIERR,DGMSG
138 ;Changes of interest to MPI
139 I DGAUD=1,DGFIL=2 D
140 .I DGFLD=.01 S DGMPI=1
141 .I DGFLD=.2403,DGOLD_","'=DGNAM S DGMPI=1
142 Q
143 ;
144LAST() ;Check stop point
145 I $P(^XTMP(DGNMSP,0),U,5)="STOP" S DGOUT=1 Q DGOUT
146 I $G(DGLIM)="SR",DGIEN>DGLIM(DGLIM) S DGOUT=1 Q DGOUT
147 I DGIEN#100=0 D
148 .I $G(DGLIM)="SD",$$NOW^XLFDT()>DGLIM(DGLIM) S DGOUT=1 Q
149 .D STOP^DG53244V
150 Q DGOUT
151 ;
152RECORD(DGFIL,DGFLD,DGREC,DGNAM,DGAUD,DGNMSP,DGIEN,DGOLD) ;file changes in ^XTMP
153 ;^XTMP global format:
154 ;^XTMP("DPTNAME",0)=purge_date^date_created^process^last_ien^
155 ; stop_flag^name_change_mail_group
156 ;^XTMP("DPTNAME",0,0)=conversion_start^conversion_end
157 ;^XTMP("DPTNAME",0,n)=conversion_start^conversion_end^
158 ; pts_evaluated_start^pts_evaluated_end
159 ;^XTMP("DPTNAME",DFN,FILE,IFN,FIELD)=old_value^new_value^change_types
160 ;^XTMP("DPTNAME",DFN,"MPI")=1^1^1^1^1^1 (status of MPI messaging)
161 ;^XTMP("DPTNAME",DFN,"MPI","A31")=the result of call to $$A31^MPIFA31B
162 ;^XTMP("DPTNAME","STATS")=names_evaluated^pts_w/changes^total_changes^
163 ; type1_changes^type2_changes^type3_changes^
164 ; type4_changes
165 ;^XTMP("DPTNAME","STATS",FILE,FIELD)=total_evaluated^total_changed^
166 ; type1_changes^type2_changes^
167 ; type3_changes^type4_changes
168 ;^XTMP("DPTNAME","B",NAME)=dfn
169 ;
170 ;Data change types: 1=name contains no comma
171 ; 2=parenthetical text is removed
172 ; 3=value could not be converted
173 ; 4=characters are removed or changed
174 ;
175 N DGIENS,DGIEN2,DGTSTR,DGI,DGN S DGTSTR=""
176 S DGIEN2=$S($P(DGREC,",",2):$P(DGREC,",",2),1:DGIEN)
177 ;Record values
178 F DGI=1:1:4 I $D(DGAUD(DGI)) D
179 .S DGTSTR=DGTSTR_DGI
180 .;Field changes by type
181 .S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U,(DGI+2))=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U,(DGI+2))+1
182 .;Total changes by type
183 .S $P(^XTMP(DGNMSP,"STATS"),U,(DGI+3))=$P($G(^XTMP(DGNMSP,"STATS")),U,(DGI+3))+1
184 .Q
185 ;Total patients with changes
186 I '$D(^XTMP(DGNMSP,DGIEN)) S $P(^XTMP(DGNMSP,"STATS"),U,2)=$P($G(^XTMP(DGNMSP,"STATS")),U,2)+1
187 ;Total fields with changes
188 S $P(^XTMP(DGNMSP,"STATS"),U,3)=$P($G(^XTMP(DGNMSP,"STATS")),U,3)+1
189 ;Total changes by field
190 S $P(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD),U,2)=$P($G(^XTMP(DGNMSP,"STATS",DGFIL,DGFLD)),U,2)+1
191 ;PATIENT field name change and types
192 S ^XTMP(DGNMSP,DGIEN,DGFIL,DGIEN2,DGFLD)=DGOLD_U_DGNAM_U_DGTSTR
193 ;Name x-ref
194 S DGN=$P($G(^DPT(DGIEN,0)),U) S:DGN="" DGN=" "
195 S ^XTMP(DGNMSP,"B",DGN,DGIEN)=""
196 Q
197 ;
198RMPI(DGP,DGMPI) ;Record MPI notification status
199 S $P(^XTMP("DPTNAME",DGIEN,"MPI"),U,DGP)=1
200 Q:'$D(DGMPI) S ^XTMP("DPTNAME",DGIEN,"MPI","A31")=DGMPI
201 Q
202 ;
203INV(DGIENS) ;Invert the IENS
204 N DGI,DGX
205 Q:DGIENS?."," ""
206 S:DGIENS'?.E1"," DGIENS=DGIENS_","
207 S DGX="" F DGI=$L(DGIENS,",")-1:-1:1 S DGX=DGX_$P(DGIENS,",",DGI)_":"
208 S:DGX?.E1":" DGX=$E(DGX,1,$L(DGX)-1)
209 Q DGX
210 ;
211FIELD ;;
212 ;;NAME^.01^0;1^1.01^30^^ANAM01
213 ;;K-NAME^.211^.21;1^1.02^^^ANAM211
214 ;;K2-NAME^.2191^.211;1^1.03^^^ANAM2191
215 ;;FATHER'S NAME^.2401^.24;1^1.04^^^ANAM2401
216 ;;MOTHER'S NAME^.2402^.24;2^1.05^^^ANAM2402
217 ;;MOTHER'S MAIDEN^.2403^.24;3^1.06^^^ANAM2403
218 ;;E-NAME^.331^.33;1^1.07^^^ANAM331
219 ;;E2-NAME^.3311^.331;1^1.08^^^ANAM3311
220 ;;D NAME^.341^.34;1^1.09^^^ANAM341
221 ;;ALIAS^.01^.01;0;1^100.03^30^2.01^ANAM201
222 ;;ATTORNEY^30^DIS;3;1^100.21^30^2.101^ANAM1001
Note: See TracBrowser for help on using the repository browser.