EASEC100 ;ALB/BRM,LBD - Print 1010EC LTC Enrollment form ; 3/1/02 8:22am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,16,40,45**;Mar 15, 2001
;
; This routine is called by EASEC10E to gather veteran data to be
; printed in the 1010EC (Long Term Care) form.
;
GETDATA(EASDFN,EAINFO) ;get veterans LTC data to be printed
;Input:
; EASDFN - DFN for the Patient file (#2)
;Output:
; ^TMP("1010EC",$J
;
N EASROOT,DGINC,DGINR,DGREL,DGDEP
S EASROOT="^TMP(""1010EC"",$J,"_EASDFN_","
; data for section 1
D DATA1(EASDFN,.EAINFO,EASROOT)
; data for section 2
D DATA2(EASDFN,EASROOT)
; data for section 3
D DATA3(EASDFN,.EAINFO,EASROOT,.DGINC)
; data for section 4 and part of section 5
D DATA4(EASDFN,EASROOT,.DGINC)
; data for section 5
D DATA5(EASDFN,EASROOT,.DGINC)
; data for section 6
D DATA6(EASDFN,EASROOT,.DGINC)
; data for section 8
D DATA8(EASROOT,.EAINFO)
Q
;
DATA1(EASDFN,EAINFO,EASROOT) ;data for section 1
N EASINS,INSTMP,MDATA,EASROOT1,MPA,MPB,MPADT,MPBDT,MCN
S EASROOT1=EASROOT_"1)"
S @EASROOT1@(1)=$G(EAINFO("VET")) ;name
S @EASROOT1@(2)=$G(EAINFO("SSN")) ;ssn
S @EASROOT1@(3)=$$GET1^DIQ(2,EASDFN_",",".381","E") ;medicaid
; ** determine medicare info
S EASINS=0,(MPA,MPB)="NO",(MPADT,MPBDT,MCN)=""
N EAX,INSUR
I $$INSUR^IBBAPI(EASDFN,,"RA",.EAX,"*") ; Retrieve all active insurance
I $D(EAX) D
. M INSUR=EAX("IBBAPI","INSUR")
. S EASINS=0
. F S EASINS=$O(INSUR(EASINS)) Q:'EASINS D
. . Q:$P(INSUR(EASINS,1),U,2)'["MEDICARE (WNR)" ; Look for MEDICARE insurance
. . I $P(INSUR(EASINS,8),U,2)="PART A" S MPA="YES",MPADT=$$FMTE^XLFDT(INSUR(EASINS,10)),MCN=INSUR(EASINS,14) Q ; If Policy Name is "PART A", set the Part A variables
. . I $P(INSUR(EASINS,8),U,2)="PART B" S MPB="YES",MPBDT=$$FMTE^XLFDT(INSUR(EASINS,10)),MCN=INSUR(EASINS,14) Q ; If Policy Name is "PART B", set the Part B variables
S @EASROOT1@(4)=MPA ;medicare part a
S @EASROOT1@(5)=MPADT ;medicare part a effective date
S @EASROOT1@(6)=MPB ;medicare part b
S @EASROOT1@(7)=MPBDT ;medicare part b effective date
S @EASROOT1@(8)=MCN ;medicare claim number
Q
DATA2(EASDFN,EASROOT) ;data for section 2
N EASI,EASINS,X,Z,EASROOT2,EASINS,CNT,NUM,EASIN1I,GRPIEN,INSUR,DGX
S EASROOT2=EASROOT_"2)"
S @EASROOT2@(1)=$$GET1^DIQ(2,EASDFN_",",".3192","E") ;covered by ins
; Set up array by defining "null" palce holders
F X=2:1:22 S @EASROOT2@(X)=""
F I=3,10,17 F Z=.111:.001:.116 S @EASROOT2@(I,Z)=""
;
S EASI=0,CNT=2
I $$INSUR^IBBAPI(EASDFN,"","ARB",.DGX,"*") ; Call Insurance API for data
M INSUR=DGX("IBBAPI","INSUR") ; Reformat insurance array into more friendly format
F S EASI=$O(INSUR(EASI)) Q:'EASI!(CNT>16) D ; Print out only first 3 entries found.
. S @EASROOT2@(CNT+3)=$G(INSUR(EASI,13)) ; SUBSCRIBER NAME
. S @EASROOT2@(CNT+4)=$P($G(INSUR(EASI,19)),U,2) ;relationship
. S @EASROOT2@(CNT+5)=$G(INSUR(EASI,14)) ;policy # (SUBSCRIBER ID)
. S @EASROOT2@(CNT+6)=$P($G(INSUR(EASI,8)),U,2) ; GROUP NAME
.; Set Insurance Company Information
. S @EASROOT2@(CNT)=$P($G(INSUR(EASI,1)),U,2) ; Insurance Co. Name
. S @EASROOT2@(CNT+2)=$G(INSUR(EASI,6)) ; ins. phone
. S @EASROOT2@((CNT+1),.111)=$G(INSUR(EASI,2)) ; INS. ADDRESS
. S @EASROOT2@((CNT+1),.114)=$G(INSUR(EASI,3)) ; INS. CITY
. S @EASROOT2@((CNT+1),.115)=$P($G(INSUR(EASI,4)),U,2) ; INS. STATE
. S @EASROOT2@((CNT+1),.116)=$G(INSUR(EASI,5)) ; INS. ZIP
.S CNT=CNT+7
Q
INSDAT(EASINS,CNT) ;obtain insurance information from the insurance file (#36)
Q:'EASINS
N X,INSDAT,ERR
D GETS^DIQ(36,EASINS_",",".01;.111:.116;.131","E","INSDAT","ERR")
Q:$D(ERR)
S @EASROOT2@(CNT)=$G(INSDAT(36,EASINS_",",.01,"E")) ;insurance name
F X=.111:.001:.116 S @EASROOT2@((CNT+1),X)=$G(INSDAT(36,EASINS_",",X,"E")) ;insurance address
S @EASROOT2@(CNT+2)=$G(INSDAT(36,EASINS_",",.131,"E")) ;ins. phone
Q
DATA3(EASDFN,EAINFO,EASROOT,DGINC) ;data for section 3
N INFO13,DEP1,DEP,X,I,EASROOT3,SSN
S EASROOT3=EASROOT_"3)"
F X=0:1:11 S @EASROOT3@(X)=""
D ALL^EASECU21(EASDFN,"SCV",EAINFO("MTDT"),"IPR",$G(EAINFO("DGMTIEN")))
;Marital Status added for LTC Phase IV (EAS*1*40)
S @EASROOT3@(0)=$$GET1^DIQ(2,EASDFN,".05","E")
S:$$GET1^DIQ(408.22,+$G(DGINR("V")),".17","I") @EASROOT3@(0)="LEGALLY SEPARATED"
D:$D(DGREL("S"))
.S INFO13=$G(^DGPR(408.13,+$P(DGREL("S"),"^",2),0))
.S @EASROOT3@(1)=$P(INFO13,"^") ;Spouse Name
.S SSN=$P(INFO13,"^",9) ;Spouse SSN
.S @EASROOT3@(3)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
.S:$G(DGINR("V")) @EASROOT3@(2)=$$GET1^DIQ(408.22,DGINR("V"),".16","E") ;Spouse Residing in the Community?
Q:'$D(DGREL("C"))
S DEP=""
F S DEP=$O(DGREL("C",DEP)) Q:'DEP!(DEP>2) D
.Q:'$D(^DGPR(408.13,+$P(DGREL("C",DEP),"^",2),0))
.S INFO13=$G(^DGPR(408.13,+$P(DGREL("C",DEP),"^",2),0))
.S DEP1=$S(DEP=1:4,DEP=2:8)
.S @EASROOT3@(DEP1)=$P(INFO13,"^") ;Dependent Name
.S @EASROOT3@(DEP1+1)=$$FMTE^XLFDT($P(INFO13,"^",3)) ;Dependent DOB
.S SSN=$P(INFO13,"^",9) ;Dependent SSN
.S @EASROOT3@(DEP1+2)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
.S:$G(DGINR("C",DEP)) @EASROOT3@(DEP1+3)=$$GET1^DIQ(408.22,DGINR("C",DEP),".16","E") ;Dependent Living in Community?
Q
DATA4(EASDFN,EASROOT,DGINC) ;data for section 4 and the first part of 5
N EASROOT4,EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
S EASROOT4=EASROOT_"4)"
S EASROOT5=EASROOT_"5)"
;Add subscripts to array to store assets for spouse (needed for new
;10-10EC form). LTC Phase IV (EAS*1*40)
F I=1:.5:4.5 S @EASROOT4@(I)=""
F I=1:.5:5.5 S @EASROOT5@(I)=""
F X="V","S" Q:'$D(DGINC(X)) D
.D GETS^DIQ(408.21,+DGINC(X),"2.01;2.02;2.06:2.09","I","ASSET"_X)
.S NUM=$S(X="V":1,1:1.5)
.S IENS=+DGINC(X)_","
.S ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
.;Fixed Assets
.S @EASROOT4@(NUM)=+$G(@(ASSETRT_"2.06,""I"")")) ;Residence
.S @EASROOT4@(NUM+1)=+$G(@(ASSETRT_"2.07,""I"")")) ;Land/Farm
.S @EASROOT4@(NUM+2)=+$G(@(ASSETRT_"2.08,""I"")")) ;Vehicles
.;Liquid Assets
.S @EASROOT5@(NUM)=+$G(@(ASSETRT_"2.01,""I"")")) ;Cash
.S @EASROOT5@(NUM+1)=+$G(@(ASSETRT_"2.02,""I"")")) ;Stocks
.S @EASROOT5@(NUM+2)=+$G(@(ASSETRT_"2.09,""I"")")) ;Other
.;Subtotals
.F I=NUM:1:(NUM+2) S @EASROOT4@(NUM+3)=@EASROOT4@(NUM+3)+@EASROOT4@(I),@EASROOT5@(NUM+3)=@EASROOT5@(NUM+3)+@EASROOT5@(I) ;Sub-totals
S @EASROOT5@(5)=@EASROOT4@(4)+@EASROOT5@(4) ;Total Assets Vet
S @EASROOT5@(5.5)=@EASROOT4@(4.5)+@EASROOT5@(4.5) ;Total Assets Spouse
Q
DATA5(EASDFN,EASROOT,DGINC) ;data for section 5 (the rest of it)
N EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
S EASROOT5=EASROOT_"5)"
F I=6:1:35 S @EASROOT5@(I)=""
F X="V","S" Q:'$D(DGINC(X)) D ;
.D GETS^DIQ(408.21,+DGINC(X),".06:.2","I","ASSET"_X)
.S NUM=$S(X="V":6,X="S":7)
.S IENS=+DGINC(X)_","
.S ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
.S @EASROOT5@(NUM)=+$G(@(ASSETRT_".14,""I"")")) ;Gross Income
.S @EASROOT5@(NUM+2)=+$G(@(ASSETRT_".08,""I"")")) ;Soc. Security
.S @EASROOT5@(NUM+4)=+$G(@(ASSETRT_".15,""I"")")) ;Interest/Div
.S @EASROOT5@(NUM+6)=+$G(@(ASSETRT_".06,""I"")")) ;Retire/Pension
.S @EASROOT5@(NUM+8)=+$G(@(ASSETRT_".09,""I"")")) ;Civil Service
.S @EASROOT5@(NUM+10)=+$G(@(ASSETRT_".1,""I"")")) ;US Railroad
.S @EASROOT5@(NUM+12)=+$G(@(ASSETRT_".07,""I"")")) ;VA Pension
.S @EASROOT5@(NUM+14)=+$G(@(ASSETRT_".19,""I"")")) ;Spouse Disab
.S @EASROOT5@(NUM+16)=+$G(@(ASSETRT_".12,""I"")")) ;Unemployment
.S @EASROOT5@(NUM+18)=+$G(@(ASSETRT_".16,""I"")")) ;Workers Comp,etc
.S @EASROOT5@(NUM+20)=+$G(@(ASSETRT_".11,""I"")")) ;Military Retire
.S @EASROOT5@(NUM+22)=+$G(@(ASSETRT_".13,""I"")")) ;Other Retire
.S @EASROOT5@(NUM+24)=+$G(@(ASSETRT_".2,""I"")")) ;Court Mandated
.S @EASROOT5@(NUM+26)=+$G(@(ASSETRT_".17,""I"")")) ;Other Income
.F I=NUM:2:NUM+26 S @EASROOT5@(NUM+28)=@EASROOT5@(NUM+28)+@EASROOT5@(I) ;Total Income
Q
DATA6(EASDFN,EASROOT,DGINC) ;
N IENS,EXPRT,EASROOT6,EXPENSE
S EASROOT6=EASROOT_"6)"
F I=1:1:11 S @EASROOT6@(I)=""
Q:'$G(DGINC("V"))
D GETS^DIQ(408.21,+DGINC("V"),"1.01:1.1","I","EXPENSE")
S IENS=+DGINC("V")_","
S EXPRT="EXPENSE(408.21,"_""""_IENS_""""_","
S @EASROOT6@(1)=+$G(@(EXPRT_"1.03,""I"")")) ;Education
S @EASROOT6@(2)=+$G(@(EXPRT_"1.02,""I"")")) ;Funeral and Burial
S @EASROOT6@(3)=+$G(@(EXPRT_"1.04,""I"")")) ;Rent/Mortgage
S @EASROOT6@(4)=+$G(@(EXPRT_"1.05,""I"")")) ;Utilities
S @EASROOT6@(5)=+$G(@(EXPRT_"1.06,""I"")")) ;Car Payment
S @EASROOT6@(6)=+$G(@(EXPRT_"1.07,""I"")")) ;Food
S @EASROOT6@(7)=+$G(@(EXPRT_"1.01,""I"")")) ;Medical Expenses
S @EASROOT6@(8)=+$G(@(EXPRT_"1.08,""I"")")) ;Court-Ordered Payments
S @EASROOT6@(9)=+$G(@(EXPRT_"1.09,""I"")")) ;Insurance
S @EASROOT6@(10)=+$G(@(EXPRT_"1.1,""I"")")) ;Taxes (Income, etc)
F I=1:1:10 S @EASROOT6@(11)=@EASROOT6@(11)+@EASROOT6@(I) ;Total Expenses
Q
DATA8(EASROOT,EAINFO) ;get the word processing field for section 8
N LINE,X,EASROOT8,IENS,WP
S EASROOT8=EASROOT_"8)",LINE=0
Q:'EAINFO("DGMTIEN")
S IENS=EAINFO("DGMTIEN")_","
S X=$$GET1^DIQ(408.31,IENS,50,"","WP")
F S LINE=$O(WP(LINE)) Q:'LINE S @EASROOT8@(LINE)=$G(WP(LINE))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASEC100 9307 printed Oct 16, 2024@17:54:30 Page 2
EASEC100 ;ALB/BRM,LBD - Print 1010EC LTC Enrollment form ; 3/1/02 8:22am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,16,40,45**;Mar 15, 2001
+2 ;
+3 ; This routine is called by EASEC10E to gather veteran data to be
+4 ; printed in the 1010EC (Long Term Care) form.
+5 ;
GETDATA(EASDFN,EAINFO) ;get veterans LTC data to be printed
+1 ;Input:
+2 ; EASDFN - DFN for the Patient file (#2)
+3 ;Output:
+4 ; ^TMP("1010EC",$J
+5 ;
+6 NEW EASROOT,DGINC,DGINR,DGREL,DGDEP
+7 SET EASROOT="^TMP(""1010EC"",$J,"_EASDFN_","
+8 ; data for section 1
+9 DO DATA1(EASDFN,.EAINFO,EASROOT)
+10 ; data for section 2
+11 DO DATA2(EASDFN,EASROOT)
+12 ; data for section 3
+13 DO DATA3(EASDFN,.EAINFO,EASROOT,.DGINC)
+14 ; data for section 4 and part of section 5
+15 DO DATA4(EASDFN,EASROOT,.DGINC)
+16 ; data for section 5
+17 DO DATA5(EASDFN,EASROOT,.DGINC)
+18 ; data for section 6
+19 DO DATA6(EASDFN,EASROOT,.DGINC)
+20 ; data for section 8
+21 DO DATA8(EASROOT,.EAINFO)
+22 QUIT
+23 ;
DATA1(EASDFN,EAINFO,EASROOT) ;data for section 1
+1 NEW EASINS,INSTMP,MDATA,EASROOT1,MPA,MPB,MPADT,MPBDT,MCN
+2 SET EASROOT1=EASROOT_"1)"
+3 ;name
SET @EASROOT1@(1)=$GET(EAINFO("VET"))
+4 ;ssn
SET @EASROOT1@(2)=$GET(EAINFO("SSN"))
+5 ;medicaid
SET @EASROOT1@(3)=$$GET1^DIQ(2,EASDFN_",",".381","E")
+6 ; ** determine medicare info
+7 SET EASINS=0
SET (MPA,MPB)="NO"
SET (MPADT,MPBDT,MCN)=""
+8 NEW EAX,INSUR
+9 ; Retrieve all active insurance
IF $$INSUR^IBBAPI(EASDFN,,"RA",.EAX,"*")
+10 IF $DATA(EAX)
Begin DoDot:1
+11 MERGE INSUR=EAX("IBBAPI","INSUR")
+12 SET EASINS=0
+13 FOR
SET EASINS=$ORDER(INSUR(EASINS))
if 'EASINS
QUIT
Begin DoDot:2
+14 ; Look for MEDICARE insurance
if $PIECE(INSUR(EASINS,1),U,2)'["MEDICARE (WNR)"
QUIT
+15 ; If Policy Name is "PART A", set the Part A variables
IF $PIECE(INSUR(EASINS,8),U,2)="PART A"
SET MPA="YES"
SET MPADT=$$FMTE^XLFDT(INSUR(EASINS,10))
SET MCN=INSUR(EASINS,14)
QUIT
+16 ; If Policy Name is "PART B", set the Part B variables
IF $PIECE(INSUR(EASINS,8),U,2)="PART B"
SET MPB="YES"
SET MPBDT=$$FMTE^XLFDT(INSUR(EASINS,10))
SET MCN=INSUR(EASINS,14)
QUIT
End DoDot:2
End DoDot:1
+17 ;medicare part a
SET @EASROOT1@(4)=MPA
+18 ;medicare part a effective date
SET @EASROOT1@(5)=MPADT
+19 ;medicare part b
SET @EASROOT1@(6)=MPB
+20 ;medicare part b effective date
SET @EASROOT1@(7)=MPBDT
+21 ;medicare claim number
SET @EASROOT1@(8)=MCN
+22 QUIT
DATA2(EASDFN,EASROOT) ;data for section 2
+1 NEW EASI,EASINS,X,Z,EASROOT2,EASINS,CNT,NUM,EASIN1I,GRPIEN,INSUR,DGX
+2 SET EASROOT2=EASROOT_"2)"
+3 ;covered by ins
SET @EASROOT2@(1)=$$GET1^DIQ(2,EASDFN_",",".3192","E")
+4 ; Set up array by defining "null" palce holders
+5 FOR X=2:1:22
SET @EASROOT2@(X)=""
+6 FOR I=3,10,17
FOR Z=.111:.001:.116
SET @EASROOT2@(I,Z)=""
+7 ;
+8 SET EASI=0
SET CNT=2
+9 ; Call Insurance API for data
IF $$INSUR^IBBAPI(EASDFN,"","ARB",.DGX,"*")
+10 ; Reformat insurance array into more friendly format
MERGE INSUR=DGX("IBBAPI","INSUR")
+11 ; Print out only first 3 entries found.
FOR
SET EASI=$ORDER(INSUR(EASI))
if 'EASI!(CNT>16)
QUIT
Begin DoDot:1
+12 ; SUBSCRIBER NAME
SET @EASROOT2@(CNT+3)=$GET(INSUR(EASI,13))
+13 ;relationship
SET @EASROOT2@(CNT+4)=$PIECE($GET(INSUR(EASI,19)),U,2)
+14 ;policy # (SUBSCRIBER ID)
SET @EASROOT2@(CNT+5)=$GET(INSUR(EASI,14))
+15 ; GROUP NAME
SET @EASROOT2@(CNT+6)=$PIECE($GET(INSUR(EASI,8)),U,2)
+16 ; Set Insurance Company Information
+17 ; Insurance Co. Name
SET @EASROOT2@(CNT)=$PIECE($GET(INSUR(EASI,1)),U,2)
+18 ; ins. phone
SET @EASROOT2@(CNT+2)=$GET(INSUR(EASI,6))
+19 ; INS. ADDRESS
SET @EASROOT2@((CNT+1),.111)=$GET(INSUR(EASI,2))
+20 ; INS. CITY
SET @EASROOT2@((CNT+1),.114)=$GET(INSUR(EASI,3))
+21 ; INS. STATE
SET @EASROOT2@((CNT+1),.115)=$PIECE($GET(INSUR(EASI,4)),U,2)
+22 ; INS. ZIP
SET @EASROOT2@((CNT+1),.116)=$GET(INSUR(EASI,5))
+23 SET CNT=CNT+7
End DoDot:1
+24 QUIT
INSDAT(EASINS,CNT) ;obtain insurance information from the insurance file (#36)
+1 if 'EASINS
QUIT
+2 NEW X,INSDAT,ERR
+3 DO GETS^DIQ(36,EASINS_",",".01;.111:.116;.131","E","INSDAT","ERR")
+4 if $DATA(ERR)
QUIT
+5 ;insurance name
SET @EASROOT2@(CNT)=$GET(INSDAT(36,EASINS_",",.01,"E"))
+6 ;insurance address
FOR X=.111:.001:.116
SET @EASROOT2@((CNT+1),X)=$GET(INSDAT(36,EASINS_",",X,"E"))
+7 ;ins. phone
SET @EASROOT2@(CNT+2)=$GET(INSDAT(36,EASINS_",",.131,"E"))
+8 QUIT
DATA3(EASDFN,EAINFO,EASROOT,DGINC) ;data for section 3
+1 NEW INFO13,DEP1,DEP,X,I,EASROOT3,SSN
+2 SET EASROOT3=EASROOT_"3)"
+3 FOR X=0:1:11
SET @EASROOT3@(X)=""
+4 DO ALL^EASECU21(EASDFN,"SCV",EAINFO("MTDT"),"IPR",$GET(EAINFO("DGMTIEN")))
+5 ;Marital Status added for LTC Phase IV (EAS*1*40)
+6 SET @EASROOT3@(0)=$$GET1^DIQ(2,EASDFN,".05","E")
+7 if $$GET1^DIQ(408.22,+$GET(DGINR("V")),".17","I")
SET @EASROOT3@(0)="LEGALLY SEPARATED"
+8 if $DATA(DGREL("S"))
Begin DoDot:1
+9 SET INFO13=$GET(^DGPR(408.13,+$PIECE(DGREL("S"),"^",2),0))
+10 ;Spouse Name
SET @EASROOT3@(1)=$PIECE(INFO13,"^")
+11 ;Spouse SSN
SET SSN=$PIECE(INFO13,"^",9)
+12 SET @EASROOT3@(3)=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+13 ;Spouse Residing in the Community?
if $GET(DGINR("V"))
SET @EASROOT3@(2)=$$GET1^DIQ(408.22,DGINR("V"),".16","E")
End DoDot:1
+14 if '$DATA(DGREL("C"))
QUIT
+15 SET DEP=""
+16 FOR
SET DEP=$ORDER(DGREL("C",DEP))
if 'DEP!(DEP>2)
QUIT
Begin DoDot:1
+17 if '$DATA(^DGPR(408.13,+$PIECE(DGREL("C",DEP),"^",2),0))
QUIT
+18 SET INFO13=$GET(^DGPR(408.13,+$PIECE(DGREL("C",DEP),"^",2),0))
+19 SET DEP1=$SELECT(DEP=1:4,DEP=2:8)
+20 ;Dependent Name
SET @EASROOT3@(DEP1)=$PIECE(INFO13,"^")
+21 ;Dependent DOB
SET @EASROOT3@(DEP1+1)=$$FMTE^XLFDT($PIECE(INFO13,"^",3))
+22 ;Dependent SSN
SET SSN=$PIECE(INFO13,"^",9)
+23 SET @EASROOT3@(DEP1+2)=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+24 ;Dependent Living in Community?
if $GET(DGINR("C",DEP))
SET @EASROOT3@(DEP1+3)=$$GET1^DIQ(408.22,DGINR("C",DEP),".16","E")
End DoDot:1
+25 QUIT
DATA4(EASDFN,EASROOT,DGINC) ;data for section 4 and the first part of 5
+1 NEW EASROOT4,EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
+2 SET EASROOT4=EASROOT_"4)"
+3 SET EASROOT5=EASROOT_"5)"
+4 ;Add subscripts to array to store assets for spouse (needed for new
+5 ;10-10EC form). LTC Phase IV (EAS*1*40)
+6 FOR I=1:.5:4.5
SET @EASROOT4@(I)=""
+7 FOR I=1:.5:5.5
SET @EASROOT5@(I)=""
+8 FOR X="V","S"
if '$DATA(DGINC(X))
QUIT
Begin DoDot:1
+9 DO GETS^DIQ(408.21,+DGINC(X),"2.01;2.02;2.06:2.09","I","ASSET"_X)
+10 SET NUM=$SELECT(X="V":1,1:1.5)
+11 SET IENS=+DGINC(X)_","
+12 SET ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
+13 ;Fixed Assets
+14 ;Residence
SET @EASROOT4@(NUM)=+$GET(@(ASSETRT_"2.06,""I"")"))
+15 ;Land/Farm
SET @EASROOT4@(NUM+1)=+$GET(@(ASSETRT_"2.07,""I"")"))
+16 ;Vehicles
SET @EASROOT4@(NUM+2)=+$GET(@(ASSETRT_"2.08,""I"")"))
+17 ;Liquid Assets
+18 ;Cash
SET @EASROOT5@(NUM)=+$GET(@(ASSETRT_"2.01,""I"")"))
+19 ;Stocks
SET @EASROOT5@(NUM+1)=+$GET(@(ASSETRT_"2.02,""I"")"))
+20 ;Other
SET @EASROOT5@(NUM+2)=+$GET(@(ASSETRT_"2.09,""I"")"))
+21 ;Subtotals
+22 ;Sub-totals
FOR I=NUM:1:(NUM+2)
SET @EASROOT4@(NUM+3)=@EASROOT4@(NUM+3)+@EASROOT4@(I)
SET @EASROOT5@(NUM+3)=@EASROOT5@(NUM+3)+@EASROOT5@(I)
End DoDot:1
+23 ;Total Assets Vet
SET @EASROOT5@(5)=@EASROOT4@(4)+@EASROOT5@(4)
+24 ;Total Assets Spouse
SET @EASROOT5@(5.5)=@EASROOT4@(4.5)+@EASROOT5@(4.5)
+25 QUIT
DATA5(EASDFN,EASROOT,DGINC) ;data for section 5 (the rest of it)
+1 NEW EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
+2 SET EASROOT5=EASROOT_"5)"
+3 FOR I=6:1:35
SET @EASROOT5@(I)=""
+4 ;
FOR X="V","S"
if '$DATA(DGINC(X))
QUIT
Begin DoDot:1
+5 DO GETS^DIQ(408.21,+DGINC(X),".06:.2","I","ASSET"_X)
+6 SET NUM=$SELECT(X="V":6,X="S":7)
+7 SET IENS=+DGINC(X)_","
+8 SET ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
+9 ;Gross Income
SET @EASROOT5@(NUM)=+$GET(@(ASSETRT_".14,""I"")"))
+10 ;Soc. Security
SET @EASROOT5@(NUM+2)=+$GET(@(ASSETRT_".08,""I"")"))
+11 ;Interest/Div
SET @EASROOT5@(NUM+4)=+$GET(@(ASSETRT_".15,""I"")"))
+12 ;Retire/Pension
SET @EASROOT5@(NUM+6)=+$GET(@(ASSETRT_".06,""I"")"))
+13 ;Civil Service
SET @EASROOT5@(NUM+8)=+$GET(@(ASSETRT_".09,""I"")"))
+14 ;US Railroad
SET @EASROOT5@(NUM+10)=+$GET(@(ASSETRT_".1,""I"")"))
+15 ;VA Pension
SET @EASROOT5@(NUM+12)=+$GET(@(ASSETRT_".07,""I"")"))
+16 ;Spouse Disab
SET @EASROOT5@(NUM+14)=+$GET(@(ASSETRT_".19,""I"")"))
+17 ;Unemployment
SET @EASROOT5@(NUM+16)=+$GET(@(ASSETRT_".12,""I"")"))
+18 ;Workers Comp,etc
SET @EASROOT5@(NUM+18)=+$GET(@(ASSETRT_".16,""I"")"))
+19 ;Military Retire
SET @EASROOT5@(NUM+20)=+$GET(@(ASSETRT_".11,""I"")"))
+20 ;Other Retire
SET @EASROOT5@(NUM+22)=+$GET(@(ASSETRT_".13,""I"")"))
+21 ;Court Mandated
SET @EASROOT5@(NUM+24)=+$GET(@(ASSETRT_".2,""I"")"))
+22 ;Other Income
SET @EASROOT5@(NUM+26)=+$GET(@(ASSETRT_".17,""I"")"))
+23 ;Total Income
FOR I=NUM:2:NUM+26
SET @EASROOT5@(NUM+28)=@EASROOT5@(NUM+28)+@EASROOT5@(I)
End DoDot:1
+24 QUIT
DATA6(EASDFN,EASROOT,DGINC) ;
+1 NEW IENS,EXPRT,EASROOT6,EXPENSE
+2 SET EASROOT6=EASROOT_"6)"
+3 FOR I=1:1:11
SET @EASROOT6@(I)=""
+4 if '$GET(DGINC("V"))
QUIT
+5 DO GETS^DIQ(408.21,+DGINC("V"),"1.01:1.1","I","EXPENSE")
+6 SET IENS=+DGINC("V")_","
+7 SET EXPRT="EXPENSE(408.21,"_""""_IENS_""""_","
+8 ;Education
SET @EASROOT6@(1)=+$GET(@(EXPRT_"1.03,""I"")"))
+9 ;Funeral and Burial
SET @EASROOT6@(2)=+$GET(@(EXPRT_"1.02,""I"")"))
+10 ;Rent/Mortgage
SET @EASROOT6@(3)=+$GET(@(EXPRT_"1.04,""I"")"))
+11 ;Utilities
SET @EASROOT6@(4)=+$GET(@(EXPRT_"1.05,""I"")"))
+12 ;Car Payment
SET @EASROOT6@(5)=+$GET(@(EXPRT_"1.06,""I"")"))
+13 ;Food
SET @EASROOT6@(6)=+$GET(@(EXPRT_"1.07,""I"")"))
+14 ;Medical Expenses
SET @EASROOT6@(7)=+$GET(@(EXPRT_"1.01,""I"")"))
+15 ;Court-Ordered Payments
SET @EASROOT6@(8)=+$GET(@(EXPRT_"1.08,""I"")"))
+16 ;Insurance
SET @EASROOT6@(9)=+$GET(@(EXPRT_"1.09,""I"")"))
+17 ;Taxes (Income, etc)
SET @EASROOT6@(10)=+$GET(@(EXPRT_"1.1,""I"")"))
+18 ;Total Expenses
FOR I=1:1:10
SET @EASROOT6@(11)=@EASROOT6@(11)+@EASROOT6@(I)
+19 QUIT
DATA8(EASROOT,EAINFO) ;get the word processing field for section 8
+1 NEW LINE,X,EASROOT8,IENS,WP
+2 SET EASROOT8=EASROOT_"8)"
SET LINE=0
+3 if 'EAINFO("DGMTIEN")
QUIT
+4 SET IENS=EAINFO("DGMTIEN")_","
+5 SET X=$$GET1^DIQ(408.31,IENS,50,"","WP")
+6 FOR
SET LINE=$ORDER(WP(LINE))
if 'LINE
QUIT
SET @EASROOT8@(LINE)=$GET(WP(LINE))
+7 QUIT
