source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASEC100.m@ 1716

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

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1EASEC100 ;ALB/BRM,LBD - Print 1010EC LTC Enrollment form ; 3/1/02 8:22am
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,7,16,40,45**;Mar 15, 2001
3 ;
4 ; This routine is called by EASEC10E to gather veteran data to be
5 ; printed in the 1010EC (Long Term Care) form.
6 ;
7GETDATA(EASDFN,EAINFO) ;get veterans LTC data to be printed
8 ;Input:
9 ; EASDFN - DFN for the Patient file (#2)
10 ;Output:
11 ; ^TMP("1010EC",$J
12 ;
13 N EASROOT,DGINC,DGINR,DGREL,DGDEP
14 S EASROOT="^TMP(""1010EC"",$J,"_EASDFN_","
15 ; data for section 1
16 D DATA1(EASDFN,.EAINFO,EASROOT)
17 ; data for section 2
18 D DATA2(EASDFN,EASROOT)
19 ; data for section 3
20 D DATA3(EASDFN,.EAINFO,EASROOT,.DGINC)
21 ; data for section 4 and part of section 5
22 D DATA4(EASDFN,EASROOT,.DGINC)
23 ; data for section 5
24 D DATA5(EASDFN,EASROOT,.DGINC)
25 ; data for section 6
26 D DATA6(EASDFN,EASROOT,.DGINC)
27 ; data for section 8
28 D DATA8(EASROOT,.EAINFO)
29 Q
30 ;
31DATA1(EASDFN,EAINFO,EASROOT) ;data for section 1
32 N EASINS,INSTMP,MDATA,EASROOT1,MPA,MPB,MPADT,MPBDT,MCN
33 S EASROOT1=EASROOT_"1)"
34 S @EASROOT1@(1)=$G(EAINFO("VET")) ;name
35 S @EASROOT1@(2)=$G(EAINFO("SSN")) ;ssn
36 S @EASROOT1@(3)=$$GET1^DIQ(2,EASDFN_",",".381","E") ;medicaid
37 ; ** determine medicare info
38 S EASINS=0,(MPA,MPB)="NO",(MPADT,MPBDT,MCN)=""
39 N EAX,INSUR
40 I $$INSUR^IBBAPI(EASDFN,,"RA",.EAX,"*") ; Retrieve all active insurance
41 I $D(EAX) D
42 . M INSUR=EAX("IBBAPI","INSUR")
43 . S EASINS=0
44 . F S EASINS=$O(INSUR(EASINS)) Q:'EASINS D
45 . . Q:$P(INSUR(EASINS,1),U,2)'["MEDICARE (WNR)" ; Look for MEDICARE insurance
46 . . 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
47 . . 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
48 S @EASROOT1@(4)=MPA ;medicare part a
49 S @EASROOT1@(5)=MPADT ;medicare part a effective date
50 S @EASROOT1@(6)=MPB ;medicare part b
51 S @EASROOT1@(7)=MPBDT ;medicare part b effective date
52 S @EASROOT1@(8)=MCN ;medicare claim number
53 Q
54DATA2(EASDFN,EASROOT) ;data for section 2
55 N EASI,EASINS,X,Z,EASROOT2,EASINS,CNT,NUM,EASIN1I,GRPIEN,INSUR,DGX
56 S EASROOT2=EASROOT_"2)"
57 S @EASROOT2@(1)=$$GET1^DIQ(2,EASDFN_",",".3192","E") ;covered by ins
58 ; Set up array by defining "null" palce holders
59 F X=2:1:22 S @EASROOT2@(X)=""
60 F I=3,10,17 F Z=.111:.001:.116 S @EASROOT2@(I,Z)=""
61 ;
62 S EASI=0,CNT=2
63 I $$INSUR^IBBAPI(EASDFN,"","ARB",.DGX,"*") ; Call Insurance API for data
64 M INSUR=DGX("IBBAPI","INSUR") ; Reformat insurance array into more friendly format
65 F S EASI=$O(INSUR(EASI)) Q:'EASI!(CNT>16) D ; Print out only first 3 entries found.
66 . S @EASROOT2@(CNT+3)=$G(INSUR(EASI,13)) ; SUBSCRIBER NAME
67 . S @EASROOT2@(CNT+4)=$P($G(INSUR(EASI,19)),U,2) ;relationship
68 . S @EASROOT2@(CNT+5)=$G(INSUR(EASI,14)) ;policy # (SUBSCRIBER ID)
69 . S @EASROOT2@(CNT+6)=$P($G(INSUR(EASI,8)),U,2) ; GROUP NAME
70 .; Set Insurance Company Information
71 . S @EASROOT2@(CNT)=$P($G(INSUR(EASI,1)),U,2) ; Insurance Co. Name
72 . S @EASROOT2@(CNT+2)=$G(INSUR(EASI,6)) ; ins. phone
73 . S @EASROOT2@((CNT+1),.111)=$G(INSUR(EASI,2)) ; INS. ADDRESS
74 . S @EASROOT2@((CNT+1),.114)=$G(INSUR(EASI,3)) ; INS. CITY
75 . S @EASROOT2@((CNT+1),.115)=$P($G(INSUR(EASI,4)),U,2) ; INS. STATE
76 . S @EASROOT2@((CNT+1),.116)=$G(INSUR(EASI,5)) ; INS. ZIP
77 .S CNT=CNT+7
78 Q
79INSDAT(EASINS,CNT) ;obtain insurance information from the insurance file (#36)
80 Q:'EASINS
81 N X,INSDAT,ERR
82 D GETS^DIQ(36,EASINS_",",".01;.111:.116;.131","E","INSDAT","ERR")
83 Q:$D(ERR)
84 S @EASROOT2@(CNT)=$G(INSDAT(36,EASINS_",",.01,"E")) ;insurance name
85 F X=.111:.001:.116 S @EASROOT2@((CNT+1),X)=$G(INSDAT(36,EASINS_",",X,"E")) ;insurance address
86 S @EASROOT2@(CNT+2)=$G(INSDAT(36,EASINS_",",.131,"E")) ;ins. phone
87 Q
88DATA3(EASDFN,EAINFO,EASROOT,DGINC) ;data for section 3
89 N INFO13,DEP1,DEP,X,I,EASROOT3,SSN
90 S EASROOT3=EASROOT_"3)"
91 F X=0:1:11 S @EASROOT3@(X)=""
92 D ALL^EASECU21(EASDFN,"SCV",EAINFO("MTDT"),"IPR",$G(EAINFO("DGMTIEN")))
93 ;Marital Status added for LTC Phase IV (EAS*1*40)
94 S @EASROOT3@(0)=$$GET1^DIQ(2,EASDFN,".05","E")
95 S:$$GET1^DIQ(408.22,+$G(DGINR("V")),".17","I") @EASROOT3@(0)="LEGALLY SEPARATED"
96 D:$D(DGREL("S"))
97 .S INFO13=$G(^DGPR(408.13,+$P(DGREL("S"),"^",2),0))
98 .S @EASROOT3@(1)=$P(INFO13,"^") ;Spouse Name
99 .S SSN=$P(INFO13,"^",9) ;Spouse SSN
100 .S @EASROOT3@(3)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
101 .S:$G(DGINR("V")) @EASROOT3@(2)=$$GET1^DIQ(408.22,DGINR("V"),".16","E") ;Spouse Residing in the Community?
102 Q:'$D(DGREL("C"))
103 S DEP=""
104 F S DEP=$O(DGREL("C",DEP)) Q:'DEP!(DEP>2) D
105 .Q:'$D(^DGPR(408.13,+$P(DGREL("C",DEP),"^",2),0))
106 .S INFO13=$G(^DGPR(408.13,+$P(DGREL("C",DEP),"^",2),0))
107 .S DEP1=$S(DEP=1:4,DEP=2:8)
108 .S @EASROOT3@(DEP1)=$P(INFO13,"^") ;Dependent Name
109 .S @EASROOT3@(DEP1+1)=$$FMTE^XLFDT($P(INFO13,"^",3)) ;Dependent DOB
110 .S SSN=$P(INFO13,"^",9) ;Dependent SSN
111 .S @EASROOT3@(DEP1+2)=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
112 .S:$G(DGINR("C",DEP)) @EASROOT3@(DEP1+3)=$$GET1^DIQ(408.22,DGINR("C",DEP),".16","E") ;Dependent Living in Community?
113 Q
114DATA4(EASDFN,EASROOT,DGINC) ;data for section 4 and the first part of 5
115 N EASROOT4,EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
116 S EASROOT4=EASROOT_"4)"
117 S EASROOT5=EASROOT_"5)"
118 ;Add subscripts to array to store assets for spouse (needed for new
119 ;10-10EC form). LTC Phase IV (EAS*1*40)
120 F I=1:.5:4.5 S @EASROOT4@(I)=""
121 F I=1:.5:5.5 S @EASROOT5@(I)=""
122 F X="V","S" Q:'$D(DGINC(X)) D
123 .D GETS^DIQ(408.21,+DGINC(X),"2.01;2.02;2.06:2.09","I","ASSET"_X)
124 .S NUM=$S(X="V":1,1:1.5)
125 .S IENS=+DGINC(X)_","
126 .S ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
127 .;Fixed Assets
128 .S @EASROOT4@(NUM)=+$G(@(ASSETRT_"2.06,""I"")")) ;Residence
129 .S @EASROOT4@(NUM+1)=+$G(@(ASSETRT_"2.07,""I"")")) ;Land/Farm
130 .S @EASROOT4@(NUM+2)=+$G(@(ASSETRT_"2.08,""I"")")) ;Vehicles
131 .;Liquid Assets
132 .S @EASROOT5@(NUM)=+$G(@(ASSETRT_"2.01,""I"")")) ;Cash
133 .S @EASROOT5@(NUM+1)=+$G(@(ASSETRT_"2.02,""I"")")) ;Stocks
134 .S @EASROOT5@(NUM+2)=+$G(@(ASSETRT_"2.09,""I"")")) ;Other
135 .;Subtotals
136 .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
137 S @EASROOT5@(5)=@EASROOT4@(4)+@EASROOT5@(4) ;Total Assets Vet
138 S @EASROOT5@(5.5)=@EASROOT4@(4.5)+@EASROOT5@(4.5) ;Total Assets Spouse
139 Q
140DATA5(EASDFN,EASROOT,DGINC) ;data for section 5 (the rest of it)
141 N EASROOT5,ASSETV,ASSETS,NUM,X,ASSETRT,IENS,I
142 S EASROOT5=EASROOT_"5)"
143 F I=6:1:35 S @EASROOT5@(I)=""
144 F X="V","S" Q:'$D(DGINC(X)) D ;
145 .D GETS^DIQ(408.21,+DGINC(X),".06:.2","I","ASSET"_X)
146 .S NUM=$S(X="V":6,X="S":7)
147 .S IENS=+DGINC(X)_","
148 .S ASSETRT="ASSET"_X_"(408.21,"_""""_IENS_""""_","
149 .S @EASROOT5@(NUM)=+$G(@(ASSETRT_".14,""I"")")) ;Gross Income
150 .S @EASROOT5@(NUM+2)=+$G(@(ASSETRT_".08,""I"")")) ;Soc. Security
151 .S @EASROOT5@(NUM+4)=+$G(@(ASSETRT_".15,""I"")")) ;Interest/Div
152 .S @EASROOT5@(NUM+6)=+$G(@(ASSETRT_".06,""I"")")) ;Retire/Pension
153 .S @EASROOT5@(NUM+8)=+$G(@(ASSETRT_".09,""I"")")) ;Civil Service
154 .S @EASROOT5@(NUM+10)=+$G(@(ASSETRT_".1,""I"")")) ;US Railroad
155 .S @EASROOT5@(NUM+12)=+$G(@(ASSETRT_".07,""I"")")) ;VA Pension
156 .S @EASROOT5@(NUM+14)=+$G(@(ASSETRT_".19,""I"")")) ;Spouse Disab
157 .S @EASROOT5@(NUM+16)=+$G(@(ASSETRT_".12,""I"")")) ;Unemployment
158 .S @EASROOT5@(NUM+18)=+$G(@(ASSETRT_".16,""I"")")) ;Workers Comp,etc
159 .S @EASROOT5@(NUM+20)=+$G(@(ASSETRT_".11,""I"")")) ;Military Retire
160 .S @EASROOT5@(NUM+22)=+$G(@(ASSETRT_".13,""I"")")) ;Other Retire
161 .S @EASROOT5@(NUM+24)=+$G(@(ASSETRT_".2,""I"")")) ;Court Mandated
162 .S @EASROOT5@(NUM+26)=+$G(@(ASSETRT_".17,""I"")")) ;Other Income
163 .F I=NUM:2:NUM+26 S @EASROOT5@(NUM+28)=@EASROOT5@(NUM+28)+@EASROOT5@(I) ;Total Income
164 Q
165DATA6(EASDFN,EASROOT,DGINC) ;
166 N IENS,EXPRT,EASROOT6,EXPENSE
167 S EASROOT6=EASROOT_"6)"
168 F I=1:1:11 S @EASROOT6@(I)=""
169 Q:'$G(DGINC("V"))
170 D GETS^DIQ(408.21,+DGINC("V"),"1.01:1.1","I","EXPENSE")
171 S IENS=+DGINC("V")_","
172 S EXPRT="EXPENSE(408.21,"_""""_IENS_""""_","
173 S @EASROOT6@(1)=+$G(@(EXPRT_"1.03,""I"")")) ;Education
174 S @EASROOT6@(2)=+$G(@(EXPRT_"1.02,""I"")")) ;Funeral and Burial
175 S @EASROOT6@(3)=+$G(@(EXPRT_"1.04,""I"")")) ;Rent/Mortgage
176 S @EASROOT6@(4)=+$G(@(EXPRT_"1.05,""I"")")) ;Utilities
177 S @EASROOT6@(5)=+$G(@(EXPRT_"1.06,""I"")")) ;Car Payment
178 S @EASROOT6@(6)=+$G(@(EXPRT_"1.07,""I"")")) ;Food
179 S @EASROOT6@(7)=+$G(@(EXPRT_"1.01,""I"")")) ;Medical Expenses
180 S @EASROOT6@(8)=+$G(@(EXPRT_"1.08,""I"")")) ;Court-Ordered Payments
181 S @EASROOT6@(9)=+$G(@(EXPRT_"1.09,""I"")")) ;Insurance
182 S @EASROOT6@(10)=+$G(@(EXPRT_"1.1,""I"")")) ;Taxes (Income, etc)
183 F I=1:1:10 S @EASROOT6@(11)=@EASROOT6@(11)+@EASROOT6@(I) ;Total Expenses
184 Q
185DATA8(EASROOT,EAINFO) ;get the word processing field for section 8
186 N LINE,X,EASROOT8,IENS,WP
187 S EASROOT8=EASROOT_"8)",LINE=0
188 Q:'EAINFO("DGMTIEN")
189 S IENS=EAINFO("DGMTIEN")_","
190 S X=$$GET1^DIQ(408.31,IENS,50,"","WP")
191 F S LINE=$O(WP(LINE)) Q:'LINE S @EASROOT8@(LINE)=$G(WP(LINE))
192 Q
Note: See TracBrowser for help on using the repository browser.