source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEZW.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1EASEZW ;ALB/jap - Auto-process 1010EZ from Web-based Application ;10/12/00 13:08
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**2,51**;Mar 15, 2001
3 ;
4EN ;entry point from server option
5 ;standard server variables XMZ,XMRG,XMER
6 ;new incoming 1010EZ application data to be filed in #712
7 ;
8 Q:'$G(XMZ)
9 S X=$P(^XMB(3.9,XMZ,0),U,1)
10 ;won't always know the exact format of message subject
11 S X=$P(X,"SID ",2),X=$P(X,U,1),X=$P(X,":",1)
12 S EASWEBID=$TR(X," ","")
13 Q:EASWEBID=""
14 ;don't process if this web submission has been previously rec'd;
15 I $D(^EAS(712,"W",EASWEBID)) D Q
16 .S EASAPP=$O(^EAS(712,"W",EASWEBID,0))
17 .;make sure this is an automated 1010EZ data msg
18 .S OK=0 F X XMREC Q:XMER=-1 S LINE=XMRG D Q:OK
19 ..I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
20 ..I LINE["VISTA AUTOMATION" S OK=1
21 .;send receipt confirmation to get Forum in sync and quit
22 .I OK D CONFIRM(EASWEBID,EASAPP,XMZ)
23 ;continue processing if this web submission is new
24 ;get facility applying to (station #)
25 S X=$P($P(^XMB(3.9,XMZ,0),U,1),":",1) I X'="" D
26 .S EASFAC=X,X=$E(X,1,3)
27 .I +X'=X S EASFAC=""
28 ;get message receipt date
29 S EASRECD=$P($P($G(^XMB(3.9,XMZ,.6)),U,1),".",1)
30 ;set next ien for file #712 to match #.01 field, not less than 101
31 S OUT=0,CYCLE=0 F D Q:OUT Q:CYCLE>5
32 .S CYCLE=CYCLE+1
33 .S DINUM=$O(^EAS(712,"B",""),-1) S:'DINUM DINUM=$O(^EAS(712,999999999),-1)
34 .S DINUM=DINUM+1 S:DINUM<100 DINUM=DINUM+100
35 .S DIC="^EAS(712,",DIC(0)="L",DLAYGO="",(NEWIEN,X)=DINUM
36 .K DD,DO D FILE^DICN
37 .;repair faulty "B" index
38 .I Y=-1,$D(^EAS(712,NEWIEN,0)) S ^EAS(712,"B",NEWIEN,NEWIEN)="" H 3
39 .I Y>0 S OUT=1
40 Q:+Y<0
41 S (DA,EASAPP)=+Y
42 S DIE="^EAS(712,"
43 S DR=".2///^S X=XMZ;3////^S X=EASRECD;3.1///^S X=.5;3.2///^S X=""W"";4.5///^S X=EASFAC"
44 D ^DIE
45 S LINES=$$LINES()
46 I 'LINES D
47 .S DA=EASAPP,DIK="^EAS(712," D ^DIK
48 I LINES D NMSSNDOB D DESIGNEE D CONFIRM(EASWEBID,EASAPP,XMZ)
49 Q
50 ;
51LINES() ;parse data lines from message into #712 record
52 N OUT,SECT,LINE,KEYIEN,DATANM,ADDCHILD,MULTIPLE,ZM,ZMM,OUT,DA,DR,DIC,DIE,DINUM,DLAYGO
53 N ADDINSUR,ADDINCOM,ADDASSET
54 ;find beginning of data lines
55 S OUT=0 F X XMREC Q:XMER=-1 S LINE=XMRG D Q:OUT
56 .I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
57 .I LINE["VISTA AUTOMATION" S OUT=1
58 .I LINE["SECTION" D Q
59 ..S SECT=$P(LINE," - ",1),SECT=$TR(SECT," ",""),SECT=$P(SECT,"SECTION",2)
60 ..S EASSECT=$TR(SECT,".","")
61 I 'OUT Q 0
62 ;file data lines
63 ;variable EASIEN is the subrecord ien for data filing in file #712
64 S EASIEN=0,OUT=0,ADDCHILD=0
65 S ADDINSUR=0,ADDINCOM=0,ADDASSET=0
66 F X XMREC Q:XMER=-1 D Q:OUT
67 .S LINE=XMRG
68 .I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
69 .I LINE["SECTION III" D SEC3 S OUT=1 Q
70 .I $E(LINE,1,3)="EOF" Q
71 .I LINE["ADDITIONAL CHILD" S ADDCHILD=ADDCHILD+1 Q
72 .I LINE["ADDITIONAL INSURANCE" S ADDINSUR=ADDINSUR+1 Q
73 .I LINE["ADDITIONAL INCOME" S ADDINCOM=ADDINCOM+1 Q
74 .I LINE["ADDITIONAL ASSET" S ADDASSET=ADDASSET+1 Q
75 .I LINE["SECTION" D Q
76 ..S SECT=$P(LINE," - ",1),SECT=$TR(SECT," ",""),SECT=$P(SECT,"SECTION",2)
77 ..S EASSECT=$TR(SECT,".","")
78 .S ZM=1,ZMM=2
79 .F D Q:EASKEY="" S ZM=ZM+2,ZMM=ZM+1
80 ..S EASKEY=$P(LINE,U,ZM),EASKEY=$TR(EASKEY," ","")
81 ..Q:EASKEY=""
82 ..S EASDATA=$E($P(LINE,U,ZMM),1,240)
83 ..;don't file null data
84 ..Q:(EASDATA=" ")!(EASDATA="")
85 ..;don't file 'empty' dates, phone numbers, ssns, etc.
86 ..Q:(EASDATA="/") Q:(EASDATA="//") Q:(EASDATA="-") Q:(EASDATA="--") Q:(EASDATA["?")
87 ..I EASKEY["." S EASKEY=EASSECT_";"_EASKEY
88 ..;find this data element in the mapping file #711
89 ..S X=$$KEY711^EASEZU1(EASKEY),KEYIEN=+X,DATANM=$P(X,U,2)
90 ..S EASIEN=EASIEN+1
91 ..;create subrecord
92 ..S DIC="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO="",X=KEYIEN,DINUM=EASIEN
93 ..S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
94 ..K DD,DO D FILE^DICN
95 ..;file data element
96 ..S DIE="^EAS(712,EASAPP,10,",DA=EASIEN,DA(1)=EASAPP,DR(1)="10;"
97 ..S MULTIPLE=1
98 ..;I DATANM["CHILD(N)" S MULTIPLE=ADDCHILD
99 ..I DATANM["CHILD(N)" S MULTIPLE=$S(ADDINCOM:ADDINCOM,1:ADDCHILD)
100 ..I DATANM["C(N)" S MULTIPLE=ADDCHILD
101 ..I DATANM["OTHER(N)" S MULTIPLE=ADDINSUR
102 ..;I DATANM["INCOME(N)" S MULTIPLE=ADDINCOM
103 ..I DATANM["ASSET(N)" S MULTIPLE=ADDASSET
104 ..S DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;"
105 ..D ^DIE
106 Q 1
107 ;
108SEC3 ;special parsing for Section III
109 N OUT,DA,DIE,DR,X,C,LINE,EMAIL,EVERS,EXPECT,EDETL,ESERV,EAPREQ,ECOMM,ERR
110 ;find the Submission ID
111 S EASWEBID="",EMAIL="",EVERS="",EXPECT="",EDETL="",ESERV="",EAPREQ="" S OUT=0
112 F X XMREC Q:XMER=-1 D Q:OUT
113 .S LINE=XMRG
114 .I LINE["EOF",LINE["III" S OUT=1 Q
115 .I LINE["Comment" S NOCOMM=0,JJ=1 F D Q:NOCOMM Q:OUT
116 ..I JJ=1 S C=$P(LINE,U,2) S ECOMM(JJ)=C
117 ..I JJ>1,$L(LINE)>1 S ECOMM(JJ)=LINE
118 ..S JJ=JJ+1
119 ..X XMREC
120 ..I XMER=-1 S NOCOMM=1,OUT=1
121 ..S LINE=XMRG
122 ..I $E(LINE,1,30)["Services Request" S NOCOMM=1
123 .I LINE["Submit ID" S EASWEBID=$P(LINE,U,2)
124 .I LINE["Email Address" S EMAIL=$P(LINE,U,2)
125 .I LINE["Version #" S EVERS=$P(LINE,U,2)
126 .I LINE["Veteran To Mail" S X=$P(LINE,U,2),EXPECT=$S(X["Vet":1,1:"")
127 .I LINE["Provide",LINE["Details" S EDETL=$P(LINE,U,2)
128 .I LINE["Appointment Request" S X=$P(LINE,U,2),EAPREQ=$S(X="YES":1,1:0)
129 .I LINE["Services Request" S ESERV=$P(LINE,U,2)
130 ;file the Submission ID into #712 record
131 S DA=EASAPP
132 S DIE="^EAS(712,"
133 S DR=".1///^S X=EASWEBID;3.6///^S X=EVERS;3.7///^S X=EXPECT;3.8///^S X=EDETL;4.3///^S X=EMAIL;"
134 S DR=DR_"4.4///^S X=EAPREQ;12///^S X=ESERV"
135 D ^DIE
136 K DA,DIE,DR,X,Y
137 I $D(ECOMM) D WP^DIE(712,EASAPP_",",13,,"ECOMM","ERR")
138 Q
139 ;
140NMSSNDOB ;find applicant's name,ssn,dob in data subrecords & file in main record
141 ;get applicant name
142 N KEY,MDL,SUFF,N,X,Y,ZX,DA,DR,DIE
143 S KEY=$$KEY711^EASEZU1("APPLICANT LAST NAME"),EASNAME=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
144 S KEY=$$KEY711^EASEZU1("APPLICANT FIRST NAME"),EASNAME=EASNAME_","_$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
145 S KEY=$$KEY711^EASEZU1("APPLICANT MIDDLE NAME"),MDL=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
146 S KEY=$$KEY711^EASEZU1("APPLICANT SUFFIX NAME"),SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
147 I $L(EASNAME)+$L(MDL)>45 S MDL=$E(MDL,1)
148 I MDL'="" S EASNAME=EASNAME_" "_MDL
149 I SUFF'="" S EASNAME=EASNAME_" "_SUFF
150 S EASNAME=$$UC^EASEZT1($E(EASNAME,1,45))
151 ;get applicant ssn & dob
152 S KEY=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
153 S EASSSN=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1),EASSSN=$$SSNOUT^EASEZT1(EASSSN)
154 S KEY=$$KEY711^EASEZU1("APPLICANT DATE OF BIRTH")
155 S EASDOB=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
156 S VETTYPE=$$VETTYPE(EASAPP)
157 S N(1)=$O(^EAS(711,"AB","APPLICANT FIRST NAME",0)),KEY(1)=$P($G(^EAS(711,N(1),0)),U,2)
158 K DA,DR S DA=EASAPP,DIE="^EAS(712,"
159 S ZX=EASSSN_"&"_EASDOB
160 S DR="1///^S X=EASNAME;2///^S X=ZX;3.3///^S X=VETTYPE"
161 D ^DIE
162 Q
163 ;
164VETTYPE(EASAPP) ;derive a veteran type categorization for this Applicant
165 ;input EASAPP = ien in file #712 for Application
166 ;output TYPE = veteran type
167 ;
168 N KEY,PH,POW,SC,SCPC,MRET,VETTYPE
169 ;get application data needed to determine veteran type
170 S KEY=$$KEY711^EASEZU1("PURPLE HEART"),PH=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
171 S KEY=$$KEY711^EASEZU1("PRISONER OF WAR"),POW=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
172 S KEY=$$KEY711^EASEZU1("SERVICE-CONNECTED"),SC=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
173 S KEY=$$KEY711^EASEZU1("RATED PERCENTAGE"),SCPC=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
174 S KEY=$$KEY711^EASEZU1("RETIRED FROM MILITARY"),MRET=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
175 ;set veteran type
176 I PH="Y" Q 5
177 I POW="Y" Q 4
178 I SC="Y" S TYPE=$S(+SCPC>49:1,+SCPC=0:3,1:2) Q TYPE
179 I MRET="Y" Q 6
180 Q 7
181 ;
182DESIGNEE ;set either NOK or E-CONTACT data into DESIGNEE
183 N DIC,DIE,DA,DR,X,Y,EASDATA,TYPE,MULTIPLE,XPART,KEY,EASIEN
184 S KEY=$$KEY711^EASEZU1("DESIGNEE")
185 S EZDATA=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
186 I (EZDATA["EMERGENCY")!(EZDATA["CONTACT") S TYPE="E-CONTACT"
187 E S TYPE="NEXT-OF-KIN"
188 ;place all NOK or E-CONTACT data in DESIGNEE data lements
189 F I=1:1 S X=$P($T(DSGDAT+I),";;",2) Q:X="QUIT" D
190 .S XPART=$P(X,";",1)
191 .S KEY=$$KEY711^EASEZU1(TYPE_" "_XPART)
192 .Q:KEY=.1
193 .S KEYIEN=+$P(KEY,U,1),DATAKEY=$P(KEY,U,3)
194 .;in file #2, multiple is always 1
195 .S MULTIPLE=1
196 .;get the data element for the NOK or E-CONT
197 .S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),EASDATA=$P(X,U,1)
198 .Q:EASDATA=""
199 .;and file it as DESIGNEE
200 .;create subrecord
201 .S X=$$KEY711^EASEZU1("DESIGNEE"_" "_XPART),KEYIEN=+X
202 .S EASIEN=$O(^EAS(712,EASAPP,10,999),-1)+1
203 .S DIC="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO="",X=KEYIEN,DINUM=EASIEN
204 .S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
205 .K DD,DO D FILE^DICN
206 .;file data element
207 .S DIE="^EAS(712,EASAPP,10,",DA=EASIEN,DA(1)=EASAPP,DR(1)="10;"
208 .S DR=".1///^S X=1;1///^S X=EASDATA;"
209 .D ^DIE
210 Q
211 ;
212DSGDAT ;
213 ;;LAST NAME;
214 ;;FIRST NAME;
215 ;;STREET ADDRESS;
216 ;;CITY;
217 ;;STATE;
218 ;;ZIP;;
219 ;;HOME PHONE AREA CODE;
220 ;;HOME PHONE NUMBER;
221 ;;WORK PHONE AREA CODE;
222 ;;WORK PHONE NUMBER;
223 ;;WORK PHONE EXTENSION;
224 ;;RELATIONSHIP;
225 ;;QUIT
226 ;
227CONFIRM(EASWEBID,EASAPP,EASXMZ) ;confirm receipt of web submission message to Forum
228 ;input EASAPP = ien in file #712
229 ; EASWEBID = web submission id
230 ; EASXMZ = ien in file #3.9 for msg being processed
231 N ARRAY,DIC,DIQ,DA,DR,STN,XMSUB,XMDUZ,XMTEXT,XMY,XMZ
232 Q:$G(EASAPP)="" Q:$G(EASWEBID)=""
233 S DA=EASAPP,DIC="^EAS(712,",DIQ="ARRAY",DIQ(0)="I",DR=".2;4.5"
234 D EN^DIQ1
235 S STN=$G(ARRAY(712,EASAPP,4.5,"I")),STN=$TR(STN," ",""),STN=STN_U_"G.VA1010EZ@"_^XMB("NETNAME")
236 S ^TMP("1010EZRC",$J,1)="Receipt Confirmation for: "_EASWEBID
237 S ^TMP("1010EZRC",$J,2)="Sent from: "_STN
238 ;send msg # from holding file record just in case current msg is a duplicate
239 S ^TMP("1010EZRC",$J,3)="Site msg #: "_$G(ARRAY(712,EASAPP,.2,"I"))
240 S XMSUB="1010EZ CONFIRMATION for SID "_EASWEBID,XMDUZ=.5
241 S XMY("1010EZ.1010EZ@FORUM.VA.GOV")=""
242 S XMTEXT="^TMP(""1010EZRC"",$J,"
243 D ^XMD
244 K ^TMP("1010EZRC",$J)
245 Q
Note: See TracBrowser for help on using the repository browser.