source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZF1.m@ 1704

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

initial load of WorldVistAEHR
File size: 7.5 KB
Line 
1EASEZF1 ;ALB/jap - Filing 1010EZ Data to Patient Database ; 8/11/05 1:50pm
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**1,51,57,62**;Mar 15, 2001
3 ;
4F2(EASAPP,EASDFN) ;file to Patient record in #2
5 ;input EASDFN = ien to #2
6 N KEYIEN,FILE,SUBFILE,FLD,DATAKEY,MULTIPLE,SECT,QUES,SUBIEN,ACCEPT,EZDATA,PTDATA,LINK,EROOT,EAS,ERR,IENS,ARRAY,ELIGVER
7 N DIC,DIQ,DA,DR,X,Y
8 Q:'$G(EASDFN)
9 L +^DPT(EASDFN)
10 I '$G(EASVRSN) S EASVRSN=$$VERSION^EASEZU4(EASAPP)
11 S KEYIEN=0
12 F S KEYIEN=$O(^TMP("EZDATA",$J,KEYIEN)) Q:'KEYIEN D
13 .S LN=^TMP("EZDATA",$J,KEYIEN),FILE=$P(LN,U,1)
14 .Q:FILE'=2
15 .S SUBFILE=$P(LN,U,2),FLD=$P(LN,U,3),DATAKEY=$P(LN,U,4)
16 .S SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
17 .;call to suppress may be redundant
18 .Q:$$SUPPRESS^EASEZU4(EASAPP,DATAKEY,1,EASVRSN)
19 .;in file #2, multiple is always 1
20 .S MULTIPLE=1
21 .Q:'$D(^TMP("EZDATA",$J,KEYIEN,MULTIPLE,1))
22 .S X=$G(^TMP("EZTEMP",$J,SECT,MULTIPLE,QUES))
23 .Q:$P(X,U,1)'=KEYIEN
24 .S EZDATA=$P(X,U,2),ACCEPT=$P(X,U,3),SUBIEN=$P(X,U,4),PTDATA=$P(X,U,5)
25 .Q:EZDATA=""
26 .Q:'SUBIEN
27 .;special handling for Designee
28 .I FLD=.3405 S EZDATA=$S(EZDATA="NEXT OF KIN":"YES",1:"NO")
29 .;strip off code display from county
30 .I SECT="I",QUES="9E." S EZDATA=$P(EZDATA," (",1)
31 .;get file #2 ien; always same as EASDFN
32 .S LINK=EASDFN
33 .;don't continue if data item not accepted
34 .Q:ACCEPT<1
35 .;process subfile data elsewhere
36 .I SUBFILE=2.01 Q
37 .I SUBFILE=2.101 Q
38 .I SUBFILE=2.02 D F202^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) Q
39 .I SUBFILE=2.06 D F206^EASEZF1(SUBFILE,DATAKEY,EZDATA,SUBIEN) Q
40 .;special conversion to file data to field #.328
41 .I FLD=.328 D
42 ..S X=$$UC^EASEZT1(EZDATA) I X="SSN" D
43 ...;allow SSN as Service Number only if field #.328 in patient record is null;
44 ...S PTSSN=$$GETANY^EASEZU1(EASAPP,EASDFN,SUBIEN)
45 ...I PTSSN="" S EZDATA="SS" Q
46 ...;otherwise Applicant SSN must match Patient SSN
47 ...S KK=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
48 ...S EZSSN=$P($G(^TMP("EZDATA",$J,KK,1,1)),U,1),EZSSN=$TR(EZSSN,"-","")
49 ...I EZSSN=PTSSN S EZDATA="SS" Q
50 ...S EZDATA="ssn"
51 ..K KK,PTSSN,EZSSN
52 .;special for fields #.092 & #.093
53 .I FILE=2,((FLD=.092)!(FLD=.093)) D FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) Q
54 .;don't need these lines after 672
55 .;special for field #.362
56 .;I FILE=2,FLD=.362,EASVRSN>5.99 I (EZDATA="Y")!(EZDATA="YES") S EZDATA="YES, RECEIVING MILITARY RETIREMENT IN LIEU OF VA COMPENSATION"
57 .Q:EZDATA=PTDATA
58 .;repeat check for verified eligibility;
59 .;do not file certain fields if eligibility verified
60 .K ARRAY
61 .S DA=EASDFN,DIC="^DPT(",DR=".3611;.3613",DIQ(0)="I",DIQ="ARRAY"
62 .D EN^DIQ1 K DA,DIC,DIQ,DR
63 .I $G(ARRAY(2,EASDFN,.3611,"I"))="V",$G(ARRAY(2,EASDFN,.3613,"I"))="H" S ELIGVER=1
64 .I FLD=.313,$G(ARRAY(2,EASDFN,.3611,"I"))="V" Q
65 .I $G(ELIGVER),((FLD=.301)!(FLD=.302)!(FLD=.36235)) Q
66 .;special for field #.32102 - Agent Orange Exposure . DATAKEY = I;14F
67 .I FLD=.32102 D F32102^EASEZF1A(EASAPP,EASDFN,EZDATA)
68 .;setup to call FM database server using EASDFN as file #2 record
69 .K EAS,ERR
70 .S IENS=EASDFN_","
71 .S EROOT="EAS("_EASAPP_")"
72 .D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
73 .;try to resolve possible invalid input for free text fields due to length
74 .I $D(ERR) D RESOLVE
75 .I $D(ERR) D ERROR^EASEZF2("AP",MULTIPLE,.ERR,"LINK")
76 .;file to database if input is valid
77 .I '$D(ERR) D
78 ..;2/1/2001 - don't attempt to file Name, SSN, DOB; too many complications;
79 ..; example: if system assigns pseudo-SSN to new patient, user could overwrite;
80 ..; example: if applicant matched to existing patient, all critical identifying
81 ..; data could be overwritten; could impact HEC as well
82 ..D FILE^DIE("S",EROOT,"ERR")
83 ..;set any replaced data into subfile #712.01 for audit
84 ..S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
85 ;
86 L -^DPT(EASDFN)
87 Q
88 ;
89RESOLVE ;try to resolve invalid input for free text fields only
90 ;see if mapped to free text field
91 N FDEF,FTYPE,MAX
92 I (SUBFILE=FILE)!(SUBFILE="") S FDEF=FILE
93 E S FDEF=SUBFILE
94 S FTYPE=$$GET1^DID(FDEF,FLD,"","TYPE")
95 Q:FTYPE'="FREE TEXT"
96 S MAX=$$GET1^DID(FDEF,FLD,"","FIELD LENGTH")
97 S EZDATA=$E(EZDATA,1,MAX)
98 K ERR
99 D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
100 ;if still sets ERR array then won't be filed to database
101 Q
102 ;
103F202(SUBFILE,DATAKEY,EZDATA,SUBIEN,KEYIEN) ;add or edit subrecord in subfile #2.02
104 ;input SUBFILE = 2.02
105 ; DATAKEY = data item identifier, e.g., I;4B.
106 ; EZDATA = in these cases, either "N(o)" or "Y(es)"
107 ; SUBIEN = subrecord # for data in #712/#10
108 ; KEYIEN = record # for data element in #711
109 N X,N,DATANM,EROOT,EAS,EIEN,ERR,FLD,IENS,EASARRAY,LINK,OUT,K1,K3
110 Q:EZDATA'["Y"
111 Q:SUBFILE'=2.02
112 ;covert data to corresponding file #10 pointer
113 S X=$$KEY711^EASEZU1(DATAKEY)
114 S K1=$P(X,U,1),DATANM=$P(X,U,2),K3=$P(X,U,3)
115 Q:(DATANM="")
116 Q:(K1'=KEYIEN)
117 Q:(K3'=DATAKEY)
118 S DATANM=$P(DATANM," - ",2),DATANM=$E(DATANM,1,30)
119 I DATANM["UNANSWERED" S DATANM="UNKNOWN BY PATIENT"
120 S EZDATA=$O(^DIC(10,"B",DATANM,0))
121 Q:EZDATA=""
122 D I202^EASEZI(EASDFN,.EASARRAY)
123 ;if matching race already exists, edit method only
124 S OUT=0,N=0 F S N=$O(EASARRAY(N)) Q:'N D
125 .Q:($P(EASARRAY(N),";",2)'=EZDATA)
126 .K EAS,ERR
127 .S IENS=EZDATA_","_EASDFN_","
128 .S EROOT="EAS("_EASAPP_")"
129 .S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
130 .D FILE^DIE("S",EROOT,"ERR")
131 .S OUT=1
132 ;no matching race in patient record, add new subrecord
133 I 'OUT D
134 .K ERR
135 .S EROOT="EAS("_EASAPP_")"
136 .S IENS="+1,"_EASDFN_",",EIEN(1)=EZDATA
137 .S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
138 .S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)=1
139 .D UPDATE^DIE("S",EROOT,"EIEN","ERR")
140 .I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
141 .S LINK=EASDFN_";"_EZDATA
142 .S ^EAS(712,EASAPP,10,SUBIEN,2)=U_LINK
143 Q
144 ;
145F206(SUBFILE,DATAKEY,EZDATA,SUBIEN) ;add subrecord in subfile #2.06
146 ;input SUBFILE = 2.06
147 ; DATAKEY = data item identifier, e.g., I;4A.
148 ; EZDATA = in these cases, either "N(o)" or "Y(es)"
149 N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,PTDATA
150 Q:SUBFILE'=2.06
151 D I206^EASEZI(EASDFN,.EASARRAY)
152 S LINK=$P($G(EASARRAY(1)),";",2),PTDATA="" I LINK S PTDATA=$P(^DPT(EASDFN,.06,LINK,0),U,1)
153 I DATAKEY="I;4A." S EZDATA=$S(EZDATA["Y":"H",$E(EZDATA,1)="N":"N",1:"U") D
154 .S EROOT="EAS("_EASAPP_")"
155 .S IENS="+1,"_EASDFN_","
156 .S FLD=.01,EAS(EASAPP,SUBFILE,IENS,FLD)=EZDATA
157 .S FLD=.02,EAS(EASAPP,SUBFILE,IENS,FLD)="SELF IDENTIFICATION"
158 .D UPDATE^DIE("ES",EROOT,"EIEN","ERR")
159 .S LINK=EASDFN_";"_$G(EIEN(1))
160 .S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
161 Q
162 ;
163FPOB(DATAKEY,EZDATA,SUBIEN,PTDATA) ;add or edit pob city & state
164 ;input DATAKEY = data item identifier, either, I;8A. or I;8B.
165 ; EZDATA = free text if city or
166 ; state abbrv if state
167 ;filing for both city & state only done when datakey=I;8A.
168 N X,EROOT,EAS,EIEN,ERR,FLD,EASARRAY,IENS,LINK,SECT,QUES,XIEN,XDATA
169 Q:(DATAKEY'="I;8A.")
170 Q:(EZDATA="")
171 Q:(EZDATA=PTDATA)
172 ;file pob city
173 K EAS,ERR
174 S FLD=.092,LINK=EASDFN
175 S IENS=EASDFN_","
176 S EROOT="EAS("_EASAPP_")"
177 D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
178 I $D(ERR) D RESOLVE
179 I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
180 D FILE^DIE("ES",EROOT,"ERR")
181 ;set any replaced data into subfile #712.01 for audit
182 S ^EAS(712,EASAPP,10,SUBIEN,2)=PTDATA_U_LINK
183 ;file pob state
184 S (EZDATA,XDATA)=""
185 S DATAKEY="I;8B.",SECT=$P(DATAKEY,";",1),QUES=$P(DATAKEY,";",2)
186 S X=$G(^TMP("EZTEMP",$J,SECT,1,QUES)),EZDATA=$P(X,U,2),XIEN=$P(X,U,4),XDATA=$P(X,U,5)
187 Q:(EZDATA="")
188 Q:(EZDATA=XDATA)
189 I (EZDATA["FOREIGN")!(EZDATA="FC")!(EZDATA="FG") S EZDATA="FOREIGN"
190 K EAS,ERR
191 S FLD=.093
192 S IENS=EASDFN_","
193 S EROOT="EAS("_EASAPP_")"
194 D VAL^DIE(2,IENS,FLD,"F",EZDATA,,EROOT,"ERR")
195 I $D(ERR) D ERROR^EASEZF2("AP",1,.ERR,"LINK") Q
196 D FILE^DIE("ES",EROOT,"ERR")
197 S ^EAS(712,EASAPP,10,XIEN,2)=XDATA_U_LINK
198 Q
Note: See TracBrowser for help on using the repository browser.