EASEZW ;ALB/jap - Auto-process 1010EZ from Web-based Application ; 5/23/08 4:30pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**2,51,70**;Mar 15, 2001;Build 26
;
EN ;entry point from server option
;standard server variables XMZ,XMRG,XMER
;new incoming 1010EZ application data to be filed in #712
;
Q:'$G(XMZ)
S X=$P(^XMB(3.9,XMZ,0),U,1)
;won't always know the exact format of message subject
S X=$P(X,"SID ",2),X=$P(X,U,1),X=$P(X,":",1)
S EASWEBID=$TR(X," ","")
Q:EASWEBID=""
;don't process if this web submission has been previously rec'd;
I $D(^EAS(712,"W",EASWEBID)) D Q
. S EASAPP=$O(^EAS(712,"W",EASWEBID,0))
. ;make sure this is an automated 1010EZ data msg
. S OK=0 F X XMREC Q:XMER=-1 S LINE=XMRG D Q:OK
. . I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
. . I LINE["VISTA AUTOMATION" S OK=1
. ;send receipt confirmation to get Forum in sync and quit
. I OK D CONFIRM(EASWEBID,EASAPP,XMZ)
;continue processing if this web submission is new
;get facility applying to (station #)
S X=$P($P(^XMB(3.9,XMZ,0),U,1),":",1) I X'="" D
. S EASFAC=X,X=$E(X,1,3)
. I +X'=X S EASFAC=""
;get message receipt date
S EASRECD=$P($P($G(^XMB(3.9,XMZ,.6)),U,1),".",1)
;set next ien for file #712 to match #.01 field, not less than 101
S OUT=0,CYCLE=0 F D Q:OUT Q:CYCLE>5
. S CYCLE=CYCLE+1
. S DINUM=$O(^EAS(712,"B",""),-1) S:'DINUM DINUM=$O(^EAS(712,999999999),-1)
. S DINUM=DINUM+1 S:DINUM<100 DINUM=DINUM+100
. S DIC="^EAS(712,",DIC(0)="L",DLAYGO="",(NEWIEN,X)=DINUM
. K DD,DO D FILE^DICN
. ;repair faulty "B" index
. I Y=-1,$D(^EAS(712,NEWIEN,0)) S ^EAS(712,"B",NEWIEN,NEWIEN)="" H 3
. I Y>0 S OUT=1
Q:+Y<0
S (DA,EASAPP)=+Y
S DIE="^EAS(712,"
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"
D ^DIE
S LINES=$$LINES()
I 'LINES D
. S DA=EASAPP,DIK="^EAS(712," D ^DIK
I LINES D NMSSNDOB D DESIGNEE D CONFIRM(EASWEBID,EASAPP,XMZ)
;EAS*1.0*70 - Check for APPLICANT COUNTRY
I LINES D
. N X,EASKEY,EASDATA,EASIEN,DINUM,DIC,DIE,DLAYGO,DA,DR,MULTIPLE,ACCEPT
. S X=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
. I '$D(^EAS(712,EASAPP,10,"B",X)) D
. . S EASKEY="I;9H.",EASDATA="USA"
. . S (EASIEN,DINUM)=$O(^EAS(712,EASAPP,10,"B"),-1)+1
. . S (DIC,DIE)="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO=""
. . S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
. . K DD,DO D FILE^DICN
. . S DA=EASIEN,DR(1)="10;",MULTIPLE=1,ACCEPT=1
. . S DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;1.1///^S X=ACCEPT;"
. . D ^DIE
Q
;
LINES() ;parse data lines from message into #712 record
N OUT,SECT,LINE,KEYIEN,DATANM,ADDCHILD,MULTIPLE,ZM,ZMM,OUT,DA,DR,DIC,DIE,DINUM,DLAYGO
N ADDINSUR,ADDINCOM,ADDASSET,HIIE
;find beginning of data lines
S OUT=0 F X XMREC Q:XMER=-1 S LINE=XMRG D Q:OUT
. I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
. I LINE["VISTA AUTOMATION" S OUT=1
. I LINE["SECTION" D Q
. . S SECT=$P(LINE," - ",1),SECT=$TR(SECT," ",""),SECT=$P(SECT,"SECTION",2)
. . S EASSECT=$TR(SECT,".","")
I 'OUT Q 0
;file data lines
;variable EASIEN is the subrecord ien for data filing in file #712
S EASIEN=0,OUT=0,ADDCHILD=0
S ADDINSUR=0,ADDINCOM=0,ADDASSET=0
F X XMREC Q:XMER=-1 D Q:OUT
. S LINE=XMRG
. I (LINE["SECTION")!(LINE["Section") S LINE=$$UC^EASEZT1(LINE)
. I LINE["SECTION III" D SEC3 S OUT=1 Q
. I $E(LINE,1,3)="EOF" Q
. I LINE["ADDITIONAL CHILD" S ADDCHILD=ADDCHILD+1 Q
. I LINE["ADDITIONAL INSURANCE" S ADDINSUR=ADDINSUR+1 Q
. I LINE["ADDITIONAL INCOME" S ADDINCOM=ADDINCOM+1 Q
. I LINE["ADDITIONAL ASSET" S ADDASSET=ADDASSET+1 Q
. I LINE["SECTION" D Q
. . S SECT=$P(LINE," - ",1),SECT=$TR(SECT," ",""),SECT=$P(SECT,"SECTION",2)
. . S EASSECT=$TR(SECT,".","")
. S ZM=1,ZMM=2
. F D Q:EASKEY="" S ZM=ZM+2,ZMM=ZM+1
. . S EASKEY=$P(LINE,U,ZM),EASKEY=$TR(EASKEY," ","")
. . Q:EASKEY=""
. . S EASDATA=$E($P(LINE,U,ZMM),1,240)
. . ;don't file null data
. . Q:(EASDATA=" ")!(EASDATA="")
. . ;don't file 'empty' dates, phone numbers, ssns, etc.
. . Q:(EASDATA="/") Q:(EASDATA="//") Q:(EASDATA="-") Q:(EASDATA="--") Q:(EASDATA["?")
. . I EASKEY["." S EASKEY=EASSECT_";"_EASKEY
. . I (EASKEY="IIE;1.")!(EASKEY="IIE;2.")!(EASKEY="IIE;3.") S HIIE(EASKEY)=EASDATA
. . I (EASKEY="IIE;1.1")!(EASKEY="IIE;2.1")!(EASKEY="IIE;3.1") S EASDATA=$G(HIIE($E(EASKEY,1,6)))
. . ;find this data element in the mapping file #711
. . S X=$$KEY711^EASEZU1(EASKEY),KEYIEN=+X,DATANM=$P(X,U,2)
. . S EASIEN=EASIEN+1
. . ;create subrecord
. . S DIC="^EAS(712,EASAPP,10,",DIC(0)="L",DLAYGO="",X=KEYIEN,DINUM=EASIEN
. . S DA(1)=EASAPP,DIC("P")=$P(^DD(712,10,0),U,2)
. . K DD,DO D FILE^DICN
. . ;file data element
. . S DIE="^EAS(712,EASAPP,10,",DA=EASIEN,DA(1)=EASAPP,DR(1)="10;"
. . S MULTIPLE=1
. . ;I DATANM["CHILD(N)" S MULTIPLE=ADDCHILD
. . I DATANM["CHILD(N)" S MULTIPLE=$S(ADDINCOM:ADDINCOM,1:ADDCHILD)
. . I DATANM["C(N)" S MULTIPLE=ADDCHILD
. . I DATANM["OTHER(N)" S MULTIPLE=ADDINSUR
. . ;I DATANM["INCOME(N)" S MULTIPLE=ADDINCOM
. . I DATANM["ASSET(N)" S MULTIPLE=ADDASSET
. . S DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;"
. . D ^DIE
Q 1
;
;EAS*1.0*70 -
;The following sections were split out to EASEZW2 to reduce routine
;size, but the tags still left in for other routines calling this one.
;
SEC3 ;special parsing for Section III
D SEC3^EASEZW2 ;EAS*1.0*70 - split out to reduce rtn size
Q
;
NMSSNDOB ;find applicant's name,ssn,dob in data subrecords & file in main record
D NMSSNDOB^EASEZW2 ;EAS*1.0*70 - split out to reduce rtn size
Q
;
VETTYPE(EASAPP) ;derive a veteran type categorization for this Applicant
;input EASAPP = ien in file #712 for Application
;output TYPE = veteran type
;
Q $$VETTYPE^EASEZW2(EASAPP) ;EAS*1.0*70 - split out to reduce rtn size
;
DESIGNEE ;set either NOK or E-CONTACT data into DESIGNEE
D DESIGNEE^EASEZW2 ;EAS*1.0*70 - split out to reduce rtn size
Q
;
DSGDAT ;
;;LAST NAME;
;;FIRST NAME;
;;STREET ADDRESS;
;;CITY;
;;STATE;
;;ZIP;;
;;HOME PHONE AREA CODE;
;;HOME PHONE NUMBER;
;;WORK PHONE AREA CODE;
;;WORK PHONE NUMBER;
;;WORK PHONE EXTENSION;
;;RELATIONSHIP;
;;QUIT
;
CONFIRM(EASWEBID,EASAPP,EASXMZ) ;confirm receipt of web submission message to Forum
;input EASAPP = ien in file #712
; EASWEBID = web submission id
; EASXMZ = ien in file #3.9 for msg being processed
D CONFIRM^EASEZW2(EASWEBID,EASAPP,EASXMZ) ;EAS*1.0*70 - split out to reduce rtn size
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZW 6553 printed Sep 23, 2025@19:31:23 Page 2
EASEZW ;ALB/jap - Auto-process 1010EZ from Web-based Application ; 5/23/08 4:30pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**2,51,70**;Mar 15, 2001;Build 26
+2 ;
EN ;entry point from server option
+1 ;standard server variables XMZ,XMRG,XMER
+2 ;new incoming 1010EZ application data to be filed in #712
+3 ;
+4 if '$GET(XMZ)
QUIT
+5 SET X=$PIECE(^XMB(3.9,XMZ,0),U,1)
+6 ;won't always know the exact format of message subject
+7 SET X=$PIECE(X,"SID ",2)
SET X=$PIECE(X,U,1)
SET X=$PIECE(X,":",1)
+8 SET EASWEBID=$TRANSLATE(X," ","")
+9 if EASWEBID=""
QUIT
+10 ;don't process if this web submission has been previously rec'd;
+11 IF $DATA(^EAS(712,"W",EASWEBID))
Begin DoDot:1
+12 SET EASAPP=$ORDER(^EAS(712,"W",EASWEBID,0))
+13 ;make sure this is an automated 1010EZ data msg
+14 SET OK=0
FOR
XECUTE XMREC
if XMER=-1
QUIT
SET LINE=XMRG
Begin DoDot:2
+15 IF (LINE["SECTION")!(LINE["Section")
SET LINE=$$UC^EASEZT1(LINE)
+16 IF LINE["VISTA AUTOMATION"
SET OK=1
End DoDot:2
if OK
QUIT
+17 ;send receipt confirmation to get Forum in sync and quit
+18 IF OK
DO CONFIRM(EASWEBID,EASAPP,XMZ)
End DoDot:1
QUIT
+19 ;continue processing if this web submission is new
+20 ;get facility applying to (station #)
+21 SET X=$PIECE($PIECE(^XMB(3.9,XMZ,0),U,1),":",1)
IF X'=""
Begin DoDot:1
+22 SET EASFAC=X
SET X=$EXTRACT(X,1,3)
+23 IF +X'=X
SET EASFAC=""
End DoDot:1
+24 ;get message receipt date
+25 SET EASRECD=$PIECE($PIECE($GET(^XMB(3.9,XMZ,.6)),U,1),".",1)
+26 ;set next ien for file #712 to match #.01 field, not less than 101
+27 SET OUT=0
SET CYCLE=0
FOR
Begin DoDot:1
+28 SET CYCLE=CYCLE+1
+29 SET DINUM=$ORDER(^EAS(712,"B",""),-1)
if 'DINUM
SET DINUM=$ORDER(^EAS(712,999999999),-1)
+30 SET DINUM=DINUM+1
if DINUM<100
SET DINUM=DINUM+100
+31 SET DIC="^EAS(712,"
SET DIC(0)="L"
SET DLAYGO=""
SET (NEWIEN,X)=DINUM
+32 KILL DD,DO
DO FILE^DICN
+33 ;repair faulty "B" index
+34 IF Y=-1
IF $DATA(^EAS(712,NEWIEN,0))
SET ^EAS(712,"B",NEWIEN,NEWIEN)=""
HANG 3
+35 IF Y>0
SET OUT=1
End DoDot:1
if OUT
QUIT
if CYCLE>5
QUIT
+36 if +Y<0
QUIT
+37 SET (DA,EASAPP)=+Y
+38 SET DIE="^EAS(712,"
+39 SET DR=".2///^S X=XMZ;3////^S X=EASRECD;3.1///^S X=.5;3.2///^S X=""W"";4.5///^S X=EASFAC"
+40 DO ^DIE
+41 SET LINES=$$LINES()
+42 IF 'LINES
Begin DoDot:1
+43 SET DA=EASAPP
SET DIK="^EAS(712,"
DO ^DIK
End DoDot:1
+44 IF LINES
DO NMSSNDOB
DO DESIGNEE
DO CONFIRM(EASWEBID,EASAPP,XMZ)
+45 ;EAS*1.0*70 - Check for APPLICANT COUNTRY
+46 IF LINES
Begin DoDot:1
+47 NEW X,EASKEY,EASDATA,EASIEN,DINUM,DIC,DIE,DLAYGO,DA,DR,MULTIPLE,ACCEPT
+48 SET X=+$$KEY711^EASEZU1("APPLICANT COUNTRY")
+49 IF '$DATA(^EAS(712,EASAPP,10,"B",X))
Begin DoDot:2
+50 SET EASKEY="I;9H."
SET EASDATA="USA"
+51 SET (EASIEN,DINUM)=$ORDER(^EAS(712,EASAPP,10,"B"),-1)+1
+52 SET (DIC,DIE)="^EAS(712,EASAPP,10,"
SET DIC(0)="L"
SET DLAYGO=""
+53 SET DA(1)=EASAPP
SET DIC("P")=$PIECE(^DD(712,10,0),U,2)
+54 KILL DD,DO
DO FILE^DICN
+55 SET DA=EASIEN
SET DR(1)="10;"
SET MULTIPLE=1
SET ACCEPT=1
+56 SET DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;1.1///^S X=ACCEPT;"
+57 DO ^DIE
End DoDot:2
End DoDot:1
+58 QUIT
+59 ;
LINES() ;parse data lines from message into #712 record
+1 NEW OUT,SECT,LINE,KEYIEN,DATANM,ADDCHILD,MULTIPLE,ZM,ZMM,OUT,DA,DR,DIC,DIE,DINUM,DLAYGO
+2 NEW ADDINSUR,ADDINCOM,ADDASSET,HIIE
+3 ;find beginning of data lines
+4 SET OUT=0
FOR
XECUTE XMREC
if XMER=-1
QUIT
SET LINE=XMRG
Begin DoDot:1
+5 IF (LINE["SECTION")!(LINE["Section")
SET LINE=$$UC^EASEZT1(LINE)
+6 IF LINE["VISTA AUTOMATION"
SET OUT=1
+7 IF LINE["SECTION"
Begin DoDot:2
+8 SET SECT=$PIECE(LINE," - ",1)
SET SECT=$TRANSLATE(SECT," ","")
SET SECT=$PIECE(SECT,"SECTION",2)
+9 SET EASSECT=$TRANSLATE(SECT,".","")
End DoDot:2
QUIT
End DoDot:1
if OUT
QUIT
+10 IF 'OUT
QUIT 0
+11 ;file data lines
+12 ;variable EASIEN is the subrecord ien for data filing in file #712
+13 SET EASIEN=0
SET OUT=0
SET ADDCHILD=0
+14 SET ADDINSUR=0
SET ADDINCOM=0
SET ADDASSET=0
+15 FOR
XECUTE XMREC
if XMER=-1
QUIT
Begin DoDot:1
+16 SET LINE=XMRG
+17 IF (LINE["SECTION")!(LINE["Section")
SET LINE=$$UC^EASEZT1(LINE)
+18 IF LINE["SECTION III"
DO SEC3
SET OUT=1
QUIT
+19 IF $EXTRACT(LINE,1,3)="EOF"
QUIT
+20 IF LINE["ADDITIONAL CHILD"
SET ADDCHILD=ADDCHILD+1
QUIT
+21 IF LINE["ADDITIONAL INSURANCE"
SET ADDINSUR=ADDINSUR+1
QUIT
+22 IF LINE["ADDITIONAL INCOME"
SET ADDINCOM=ADDINCOM+1
QUIT
+23 IF LINE["ADDITIONAL ASSET"
SET ADDASSET=ADDASSET+1
QUIT
+24 IF LINE["SECTION"
Begin DoDot:2
+25 SET SECT=$PIECE(LINE," - ",1)
SET SECT=$TRANSLATE(SECT," ","")
SET SECT=$PIECE(SECT,"SECTION",2)
+26 SET EASSECT=$TRANSLATE(SECT,".","")
End DoDot:2
QUIT
+27 SET ZM=1
SET ZMM=2
+28 FOR
Begin DoDot:2
+29 SET EASKEY=$PIECE(LINE,U,ZM)
SET EASKEY=$TRANSLATE(EASKEY," ","")
+30 if EASKEY=""
QUIT
+31 SET EASDATA=$EXTRACT($PIECE(LINE,U,ZMM),1,240)
+32 ;don't file null data
+33 if (EASDATA=" ")!(EASDATA="")
QUIT
+34 ;don't file 'empty' dates, phone numbers, ssns, etc.
+35 if (EASDATA="/")
QUIT
if (EASDATA="//")
QUIT
if (EASDATA="-")
QUIT
if (EASDATA="--")
QUIT
if (EASDATA["?")
QUIT
+36 IF EASKEY["."
SET EASKEY=EASSECT_";"_EASKEY
+37 IF (EASKEY="IIE;1.")!(EASKEY="IIE;2.")!(EASKEY="IIE;3.")
SET HIIE(EASKEY)=EASDATA
+38 IF (EASKEY="IIE;1.1")!(EASKEY="IIE;2.1")!(EASKEY="IIE;3.1")
SET EASDATA=$GET(HIIE($EXTRACT(EASKEY,1,6)))
+39 ;find this data element in the mapping file #711
+40 SET X=$$KEY711^EASEZU1(EASKEY)
SET KEYIEN=+X
SET DATANM=$PIECE(X,U,2)
+41 SET EASIEN=EASIEN+1
+42 ;create subrecord
+43 SET DIC="^EAS(712,EASAPP,10,"
SET DIC(0)="L"
SET DLAYGO=""
SET X=KEYIEN
SET DINUM=EASIEN
+44 SET DA(1)=EASAPP
SET DIC("P")=$PIECE(^DD(712,10,0),U,2)
+45 KILL DD,DO
DO FILE^DICN
+46 ;file data element
+47 SET DIE="^EAS(712,EASAPP,10,"
SET DA=EASIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+48 SET MULTIPLE=1
+49 ;I DATANM["CHILD(N)" S MULTIPLE=ADDCHILD
+50 IF DATANM["CHILD(N)"
SET MULTIPLE=$SELECT(ADDINCOM:ADDINCOM,1:ADDCHILD)
+51 IF DATANM["C(N)"
SET MULTIPLE=ADDCHILD
+52 IF DATANM["OTHER(N)"
SET MULTIPLE=ADDINSUR
+53 ;I DATANM["INCOME(N)" S MULTIPLE=ADDINCOM
+54 IF DATANM["ASSET(N)"
SET MULTIPLE=ADDASSET
+55 SET DR=".1///^S X=MULTIPLE;1///^S X=EASDATA;"
+56 DO ^DIE
End DoDot:2
if EASKEY=""
QUIT
SET ZM=ZM+2
SET ZMM=ZM+1
End DoDot:1
if OUT
QUIT
+57 QUIT 1
+58 ;
+59 ;EAS*1.0*70 -
+60 ;The following sections were split out to EASEZW2 to reduce routine
+61 ;size, but the tags still left in for other routines calling this one.
+62 ;
SEC3 ;special parsing for Section III
+1 ;EAS*1.0*70 - split out to reduce rtn size
DO SEC3^EASEZW2
+2 QUIT
+3 ;
NMSSNDOB ;find applicant's name,ssn,dob in data subrecords & file in main record
+1 ;EAS*1.0*70 - split out to reduce rtn size
DO NMSSNDOB^EASEZW2
+2 QUIT
+3 ;
VETTYPE(EASAPP) ;derive a veteran type categorization for this Applicant
+1 ;input EASAPP = ien in file #712 for Application
+2 ;output TYPE = veteran type
+3 ;
+4 ;EAS*1.0*70 - split out to reduce rtn size
QUIT $$VETTYPE^EASEZW2(EASAPP)
+5 ;
DESIGNEE ;set either NOK or E-CONTACT data into DESIGNEE
+1 ;EAS*1.0*70 - split out to reduce rtn size
DO DESIGNEE^EASEZW2
+2 QUIT
+3 ;
DSGDAT ;
+1 ;;LAST NAME;
+2 ;;FIRST NAME;
+3 ;;STREET ADDRESS;
+4 ;;CITY;
+5 ;;STATE;
+6 ;;ZIP;;
+7 ;;HOME PHONE AREA CODE;
+8 ;;HOME PHONE NUMBER;
+9 ;;WORK PHONE AREA CODE;
+10 ;;WORK PHONE NUMBER;
+11 ;;WORK PHONE EXTENSION;
+12 ;;RELATIONSHIP;
+13 ;;QUIT
+14 ;
CONFIRM(EASWEBID,EASAPP,EASXMZ) ;confirm receipt of web submission message to Forum
+1 ;input EASAPP = ien in file #712
+2 ; EASWEBID = web submission id
+3 ; EASXMZ = ien in file #3.9 for msg being processed
+4 ;EAS*1.0*70 - split out to reduce rtn size
DO CONFIRM^EASEZW2(EASWEBID,EASAPP,EASXMZ)
+5 QUIT
