EASEZW2 ;ALB/AMA - Auto-process 1010EZ from Web-based Application, part 2 ; 7/31/08 2:17pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**70,81**;Mar 15, 2001;Build 11
;
;This is just a continuation of EASEZW, which got too large
;
SEC3 ;special parsing for Section III
N OUT,DA,DIE,DR,X,C,LINE,EMAIL,EVERS,EXPECT,EDETL,ESERV,EAPREQ,ECOMM,ERR
;find the Submission ID
S EASWEBID="",EMAIL="",EVERS="",EXPECT="",EDETL="",ESERV="",EAPREQ="" S OUT=0
F X XMREC Q:XMER=-1 D Q:OUT
. S LINE=XMRG
. I LINE["EOF",LINE["III" S OUT=1 Q
. I LINE["Comment" S NOCOMM=0,JJ=1 F D Q:NOCOMM Q:OUT
. . I JJ=1 S C=$P(LINE,U,2) S ECOMM(JJ)=C
. . I JJ>1,$L(LINE)>1 S ECOMM(JJ)=LINE
. . S JJ=JJ+1
. . X XMREC
. . I XMER=-1 S NOCOMM=1,OUT=1
. . S LINE=XMRG
. . I $E(LINE,1,30)["Services Request" S NOCOMM=1
. I LINE["Submit ID" S EASWEBID=$P(LINE,U,2)
. I LINE["Email Address" S EMAIL=$P(LINE,U,2)
. I LINE["Version #" S EVERS=$P(LINE,U,2)
. I LINE["Veteran To Mail" S X=$P(LINE,U,2),EXPECT=$S(X["Vet":1,1:"")
. I LINE["Provide",LINE["Details" S EDETL=$P(LINE,U,2)
. ;I LINE["Appointment Request" S X=$P(LINE,U,2),EAPREQ=$S(X="YES":1,1:0)
. I LINE["Appointment Request" S X=$P(LINE,U,2),EAPREQ=$S(X["Y":1,1:0)
. I LINE["Services Request" S ESERV=$P(LINE,U,2)
;file the Submission ID into #712 record
S DA=EASAPP
S DIE="^EAS(712,"
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;"
S DR=DR_"4.4///^S X=EAPREQ;12///^S X=ESERV"
D ^DIE
K DA,DIE,DR,X,Y
I $D(ECOMM) D WP^DIE(712,EASAPP_",",13,,"ECOMM","ERR")
Q
;
NMSSNDOB ;find applicant's name,ssn,dob in data subrecords & file in main record
;get applicant name
N KEY,MDL,SUFF,N,X,Y,ZX,DA,DR,DIE
S KEY=$$KEY711^EASEZU1("APPLICANT LAST NAME"),EASNAME=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("APPLICANT FIRST NAME"),EASNAME=EASNAME_","_$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("APPLICANT MIDDLE NAME"),MDL=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("APPLICANT SUFFIX NAME"),SUFF=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
I $L(EASNAME)+$L(MDL)>45 S MDL=$E(MDL,1)
I MDL'="" S EASNAME=EASNAME_" "_MDL
I SUFF'="" S EASNAME=EASNAME_" "_SUFF
S EASNAME=$$UC^EASEZT1($E(EASNAME,1,45))
;get applicant ssn & dob
S KEY=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
S EASSSN=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1),EASSSN=$$SSNOUT^EASEZT1(EASSSN)
S KEY=$$KEY711^EASEZU1("APPLICANT DATE OF BIRTH")
S EASDOB=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S VETTYPE=$$VETTYPE(EASAPP)
S N(1)=$O(^EAS(711,"AB","APPLICANT FIRST NAME",0)),KEY(1)=$P($G(^EAS(711,N(1),0)),U,2)
K DA,DR S DA=EASAPP,DIE="^EAS(712,"
S ZX=EASSSN_"&"_EASDOB
S DR="1///^S X=EASNAME;2///^S X=ZX;3.3///^S X=VETTYPE"
D ^DIE
Q
;
VETTYPE(EASAPP) ;derive a veteran type categorization for this Applicant
;input EASAPP = ien in file #712 for Application
;output TYPE = veteran type
;
N KEY,PH,POW,SC,SCPC,MRET,VETTYPE
;get application data needed to determine veteran type
S KEY=$$KEY711^EASEZU1("PURPLE HEART"),PH=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("PRISONER OF WAR"),POW=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("SERVICE-CONNECTED"),SC=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("RATED PERCENTAGE"),SCPC=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
S KEY=$$KEY711^EASEZU1("RETIRED FROM MILITARY"),MRET=$P($$DATA712^EASEZU1(EASAPP,KEY),U,1)
;set veteran type
I PH="Y" Q 5
I POW="Y" Q 4
I SC="Y" S TYPE=$S(+SCPC>49:1,+SCPC=0:3,1:2) Q TYPE
I MRET="Y" Q 6
Q 7
;
DESIGNEE ;set either NOK or E-CONTACT data into DESIGNEE
N DIC,DIE,DA,DR,X,Y,EASDATA,TYPE,MULTIPLE,XPART,KEY,EASIEN
S KEY=$$KEY711^EASEZU1("DESIGNEE")
S EZDATA=$P($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
I (EZDATA["EMERGENCY")!(EZDATA["CONTACT") S TYPE="E-CONTACT"
E S TYPE="NEXT-OF-KIN"
;place all NOK or E-CONTACT data in DESIGNEE data elements
F I=1:1 S X=$P($T(DSGDAT+I),";;",2) Q:X="QUIT" D
. S XPART=$P(X,";",1)
. S KEY=$$KEY711^EASEZU1(TYPE_" "_XPART)
. Q:KEY=.1
. S KEYIEN=+$P(KEY,U,1),DATAKEY=$P(KEY,U,3)
. ;in file #2, multiple is always 1
. S MULTIPLE=1
. ;get the data element for the NOK or E-CONT
. S X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE),EASDATA=$P(X,U,1)
. Q:EASDATA=""
. ;and file it as DESIGNEE
. ;create subrecord
. S X=$$KEY711^EASEZU1("DESIGNEE"_" "_XPART),KEYIEN=+X
. S EASIEN=$O(^EAS(712,EASAPP,10,999),-1)+1
. 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 DR=".1///^S X=1;1///^S X=EASDATA;"
. D ^DIE
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
N ARRAY,DIC,DIQ,DA,DR,STN,XMSUB,XMDUZ,XMTEXT,XMY,XMZ
Q:$G(EASAPP)="" Q:$G(EASWEBID)=""
S DA=EASAPP,DIC="^EAS(712,",DIQ="ARRAY",DIQ(0)="I",DR=".2;4.5"
D EN^DIQ1
S STN=$G(ARRAY(712,EASAPP,4.5,"I")),STN=$TR(STN," ",""),STN=STN_U_"G.VA1010EZ@"_^XMB("NETNAME")
S ^TMP("1010EZRC",$J,1)="Receipt Confirmation for: "_EASWEBID
S ^TMP("1010EZRC",$J,2)="Sent from: "_STN
;send msg # from holding file record just in case current msg is a duplicate
S ^TMP("1010EZRC",$J,3)="Site msg #: "_$G(ARRAY(712,EASAPP,.2,"I"))
S XMSUB="1010EZ CONFIRMATION for SID "_EASWEBID,XMDUZ=.5
S XMY("1010EZ.1010EZ@DOMAIN.EXT")=""
S XMTEXT="^TMP(""1010EZRC"",$J,"
D ^XMD
K ^TMP("1010EZRC",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEZW2 5971 printed Apr 09, 2024@20:58:28 Page 2
EASEZW2 ;ALB/AMA - Auto-process 1010EZ from Web-based Application, part 2 ; 7/31/08 2:17pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**70,81**;Mar 15, 2001;Build 11
+2 ;
+3 ;This is just a continuation of EASEZW, which got too large
+4 ;
SEC3 ;special parsing for Section III
+1 NEW OUT,DA,DIE,DR,X,C,LINE,EMAIL,EVERS,EXPECT,EDETL,ESERV,EAPREQ,ECOMM,ERR
+2 ;find the Submission ID
+3 SET EASWEBID=""
SET EMAIL=""
SET EVERS=""
SET EXPECT=""
SET EDETL=""
SET ESERV=""
SET EAPREQ=""
SET OUT=0
+4 FOR
XECUTE XMREC
if XMER=-1
QUIT
Begin DoDot:1
+5 SET LINE=XMRG
+6 IF LINE["EOF"
IF LINE["III"
SET OUT=1
QUIT
+7 IF LINE["Comment"
SET NOCOMM=0
SET JJ=1
FOR
Begin DoDot:2
+8 IF JJ=1
SET C=$PIECE(LINE,U,2)
SET ECOMM(JJ)=C
+9 IF JJ>1
IF $LENGTH(LINE)>1
SET ECOMM(JJ)=LINE
+10 SET JJ=JJ+1
+11 XECUTE XMREC
+12 IF XMER=-1
SET NOCOMM=1
SET OUT=1
+13 SET LINE=XMRG
+14 IF $EXTRACT(LINE,1,30)["Services Request"
SET NOCOMM=1
End DoDot:2
if NOCOMM
QUIT
if OUT
QUIT
+15 IF LINE["Submit ID"
SET EASWEBID=$PIECE(LINE,U,2)
+16 IF LINE["Email Address"
SET EMAIL=$PIECE(LINE,U,2)
+17 IF LINE["Version #"
SET EVERS=$PIECE(LINE,U,2)
+18 IF LINE["Veteran To Mail"
SET X=$PIECE(LINE,U,2)
SET EXPECT=$SELECT(X["Vet":1,1:"")
+19 IF LINE["Provide"
IF LINE["Details"
SET EDETL=$PIECE(LINE,U,2)
+20 ;I LINE["Appointment Request" S X=$P(LINE,U,2),EAPREQ=$S(X="YES":1,1:0)
+21 IF LINE["Appointment Request"
SET X=$PIECE(LINE,U,2)
SET EAPREQ=$SELECT(X["Y":1,1:0)
+22 IF LINE["Services Request"
SET ESERV=$PIECE(LINE,U,2)
End DoDot:1
if OUT
QUIT
+23 ;file the Submission ID into #712 record
+24 SET DA=EASAPP
+25 SET DIE="^EAS(712,"
+26 SET 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;"
+27 SET DR=DR_"4.4///^S X=EAPREQ;12///^S X=ESERV"
+28 DO ^DIE
+29 KILL DA,DIE,DR,X,Y
+30 IF $DATA(ECOMM)
DO WP^DIE(712,EASAPP_",",13,,"ECOMM","ERR")
+31 QUIT
+32 ;
NMSSNDOB ;find applicant's name,ssn,dob in data subrecords & file in main record
+1 ;get applicant name
+2 NEW KEY,MDL,SUFF,N,X,Y,ZX,DA,DR,DIE
+3 SET KEY=$$KEY711^EASEZU1("APPLICANT LAST NAME")
SET EASNAME=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+4 SET KEY=$$KEY711^EASEZU1("APPLICANT FIRST NAME")
SET EASNAME=EASNAME_","_$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+5 SET KEY=$$KEY711^EASEZU1("APPLICANT MIDDLE NAME")
SET MDL=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+6 SET KEY=$$KEY711^EASEZU1("APPLICANT SUFFIX NAME")
SET SUFF=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+7 IF $LENGTH(EASNAME)+$LENGTH(MDL)>45
SET MDL=$EXTRACT(MDL,1)
+8 IF MDL'=""
SET EASNAME=EASNAME_" "_MDL
+9 IF SUFF'=""
SET EASNAME=EASNAME_" "_SUFF
+10 SET EASNAME=$$UC^EASEZT1($EXTRACT(EASNAME,1,45))
+11 ;get applicant ssn & dob
+12 SET KEY=$$KEY711^EASEZU1("APPLICANT SOCIAL SECURITY NUMBER")
+13 SET EASSSN=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
SET EASSSN=$$SSNOUT^EASEZT1(EASSSN)
+14 SET KEY=$$KEY711^EASEZU1("APPLICANT DATE OF BIRTH")
+15 SET EASDOB=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+16 SET VETTYPE=$$VETTYPE(EASAPP)
+17 SET N(1)=$ORDER(^EAS(711,"AB","APPLICANT FIRST NAME",0))
SET KEY(1)=$PIECE($GET(^EAS(711,N(1),0)),U,2)
+18 KILL DA,DR
SET DA=EASAPP
SET DIE="^EAS(712,"
+19 SET ZX=EASSSN_"&"_EASDOB
+20 SET DR="1///^S X=EASNAME;2///^S X=ZX;3.3///^S X=VETTYPE"
+21 DO ^DIE
+22 QUIT
+23 ;
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 NEW KEY,PH,POW,SC,SCPC,MRET,VETTYPE
+5 ;get application data needed to determine veteran type
+6 SET KEY=$$KEY711^EASEZU1("PURPLE HEART")
SET PH=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+7 SET KEY=$$KEY711^EASEZU1("PRISONER OF WAR")
SET POW=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+8 SET KEY=$$KEY711^EASEZU1("SERVICE-CONNECTED")
SET SC=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+9 SET KEY=$$KEY711^EASEZU1("RATED PERCENTAGE")
SET SCPC=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+10 SET KEY=$$KEY711^EASEZU1("RETIRED FROM MILITARY")
SET MRET=$PIECE($$DATA712^EASEZU1(EASAPP,KEY),U,1)
+11 ;set veteran type
+12 IF PH="Y"
QUIT 5
+13 IF POW="Y"
QUIT 4
+14 IF SC="Y"
SET TYPE=$SELECT(+SCPC>49:1,+SCPC=0:3,1:2)
QUIT TYPE
+15 IF MRET="Y"
QUIT 6
+16 QUIT 7
+17 ;
DESIGNEE ;set either NOK or E-CONTACT data into DESIGNEE
+1 NEW DIC,DIE,DA,DR,X,Y,EASDATA,TYPE,MULTIPLE,XPART,KEY,EASIEN
+2 SET KEY=$$KEY711^EASEZU1("DESIGNEE")
+3 SET EZDATA=$PIECE($$DATA712^EASEZU1(EASAPP,KEY,1),U,1)
+4 IF (EZDATA["EMERGENCY")!(EZDATA["CONTACT")
SET TYPE="E-CONTACT"
+5 IF '$TEST
SET TYPE="NEXT-OF-KIN"
+6 ;place all NOK or E-CONTACT data in DESIGNEE data elements
+7 FOR I=1:1
SET X=$PIECE($TEXT(DSGDAT+I),";;",2)
if X="QUIT"
QUIT
Begin DoDot:1
+8 SET XPART=$PIECE(X,";",1)
+9 SET KEY=$$KEY711^EASEZU1(TYPE_" "_XPART)
+10 if KEY=.1
QUIT
+11 SET KEYIEN=+$PIECE(KEY,U,1)
SET DATAKEY=$PIECE(KEY,U,3)
+12 ;in file #2, multiple is always 1
+13 SET MULTIPLE=1
+14 ;get the data element for the NOK or E-CONT
+15 SET X=$$DATA712^EASEZU1(EASAPP,KEY,MULTIPLE)
SET EASDATA=$PIECE(X,U,1)
+16 if EASDATA=""
QUIT
+17 ;and file it as DESIGNEE
+18 ;create subrecord
+19 SET X=$$KEY711^EASEZU1("DESIGNEE"_" "_XPART)
SET KEYIEN=+X
+20 SET EASIEN=$ORDER(^EAS(712,EASAPP,10,999),-1)+1
+21 SET DIC="^EAS(712,EASAPP,10,"
SET DIC(0)="L"
SET DLAYGO=""
SET X=KEYIEN
SET DINUM=EASIEN
+22 SET DA(1)=EASAPP
SET DIC("P")=$PIECE(^DD(712,10,0),U,2)
+23 KILL DD,DO
DO FILE^DICN
+24 ;file data element
+25 SET DIE="^EAS(712,EASAPP,10,"
SET DA=EASIEN
SET DA(1)=EASAPP
SET DR(1)="10;"
+26 SET DR=".1///^S X=1;1///^S X=EASDATA;"
+27 DO ^DIE
End DoDot:1
+28 QUIT
+29 ;
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 NEW ARRAY,DIC,DIQ,DA,DR,STN,XMSUB,XMDUZ,XMTEXT,XMY,XMZ
+5 if $GET(EASAPP)=""
QUIT
if $GET(EASWEBID)=""
QUIT
+6 SET DA=EASAPP
SET DIC="^EAS(712,"
SET DIQ="ARRAY"
SET DIQ(0)="I"
SET DR=".2;4.5"
+7 DO EN^DIQ1
+8 SET STN=$GET(ARRAY(712,EASAPP,4.5,"I"))
SET STN=$TRANSLATE(STN," ","")
SET STN=STN_U_"G.VA1010EZ@"_^XMB("NETNAME")
+9 SET ^TMP("1010EZRC",$JOB,1)="Receipt Confirmation for: "_EASWEBID
+10 SET ^TMP("1010EZRC",$JOB,2)="Sent from: "_STN
+11 ;send msg # from holding file record just in case current msg is a duplicate
+12 SET ^TMP("1010EZRC",$JOB,3)="Site msg #: "_$GET(ARRAY(712,EASAPP,.2,"I"))
+13 SET XMSUB="1010EZ CONFIRMATION for SID "_EASWEBID
SET XMDUZ=.5
+14 SET XMY("1010EZ.1010EZ@DOMAIN.EXT")=""
+15 SET XMTEXT="^TMP(""1010EZRC"",$J,"
+16 DO ^XMD
+17 KILL ^TMP("1010EZRC",$JOB)
+18 QUIT
