source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMCM1.m@ 1150

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1IVMCM1 ;ALB/SEK,BRM - DCD INCOME TESTS UPLOAD DRIVER ; 1/24/03
2 ;;2.0;INCOME VERIFICATION MATCH;**17,49,71**;21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; this routine will call routines to upload means/copay/LTC test and
6 ; income screening sent by the IVM Center (DCD). the calling routine
7 ; validated segment sequence. entries will be added/modified in the
8 ; following means test and patient files:
9 ;
10 ; PATIENT RELATION (#408.12)
11 ; INCOME PERSON (#408.13)
12 ; INDIVIDUAL ANNUAL INCOME (#408.21)
13 ; INCOME RELATION (#408.22)
14 ; ANNUAL MEANS TEST (#408.31)
15 ; MEANS TEST CHANGES (#408.41)
16 ; PATIENT (#2)
17 ;
18 ; input:
19 ;
20 ; IVMTYPE test type 1-means 2-copay 3-income screening 4-LTC
21 ; IVMMTIEN IEN of replaced test (408.31)
22 ; IVMFLGC # of dependent children
23 ; IVMMTDT dt of test
24 ; DGLY income year
25 ;
26 ; ^TMP($J,"IVMCM", contains data sent by IVM Center
27 ; 3rd node "PIDV"
28 ; "ZICV"
29 ; "ZIRV"
30 ; "ZDPS"
31 ; "ZICS"
32 ; "ZIRS"
33 ; {"ZDPC",N
34 ; "ZICC",N
35 ; "ZIRC",N
36 ; }
37 ; "ZMT1"
38 ; "ZMT2"
39 ; "ZMT4"
40 ; "ZBT"
41 ;
42 S:'$D(DUZ) DUZ=.5
43 ;
44 ; subscript of array IVMAR is 408.12 ien transmitted by IVM Center
45 ; or created by upload. IVMAR2 is the array used to check for dup SSNs
46 K IVMAR,IVMAR2
47 ;
48 ; New Edit Checks
49 N IVMERR,OK2UPLD S IVMERR="",OK2UPLD=1
50 D EN^IVMCMF(.IVMERR),PROB^IVMCMFB(,.IVMERR,0) Q:'OK2UPLD
51 ;
52 ; IVMHADJ indicates means test hardship/adjudication
53 ; 1-adj 2-hardship 3-pending adj 0-not adj/hard
54 I IVMTYPE=1 D
55 .S IVMSEG=$G(^TMP($J,"IVMCM","ZMT1"))
56 .S IVMHADJ=$S($P(IVMSEG,"^",13):2,$P(IVMSEG,"^",6)]"":1,$P(IVMSEG,"^",3)="P":3,1:0)
57 ;
58 S:IVMTYPE=3 DGMTI=""
59 ;
60 ; add new annual means test file (408.31) stub for Means test,
61 ; RX Copay test, or Long Term Care test
62 I "^1^2^4^"[("^"_IVMTYPE_"^") D
63 .;
64 .; input DGMTDT (.01) dt of test
65 .; DFN (.02) Patient IEN
66 .; DGMTYPT (.19) type of test
67 .; output DGMTI annual means test IEN
68 .S DGMTDT=IVMMTDT,DGMTYPT=IVMTYPE
69 .D ADD^DGMTA
70 .;
71 .; change primary income test for year?
72 .S DA=DGMTI,DIE="^DGMT(408.31,",DR="2////0"
73 .D ^DIE K DA,DIE,DR
74 ;
75 D NEWVET^IVMCM3 Q:$D(IVMFERR) ; if no entry in patient relation file for vet add
76 ;
77 ; get patient relation ien (#408.12) for vet, spouse, & child
78 S IVMREQU=$P($G(^DG(408.32,+$P($G(^DGMT(408.31,IVMMTIEN,0)),"^",3),0)),"^",2)
79 D GETREL^DGMTU11(DFN,"VSC",DGLY,$S($G(IVMMTIEN)&(IVMREQU'="R"):IVMMTIEN,1:0))
80 ;
81 ; add dependent(s) to income person file (408.13)
82 ;
83 ; add spouse if not in 408.13
84 S IVMSPCHV="S" ; spouse/child/vet indicator
85 S IVMSEG=$G(^TMP($J,"IVMCM","ZDPS")) ; spouse ZDP segment
86 D INPIEN^IVMCM2
87 Q:$D(IVMFERR)
88 ;
89 I IVMFLG5 G ADDCHILD ; entry not added - goto add children
90 ;
91 ; add entry to patient relation file (408.12)
92 D EN^IVMCM3
93 Q:$D(IVMFERR)
94 ;
95ADDS21 ; add spouse entry to individual annual income file (408.21)
96 S IVMSEG=$G(^TMP($J,"IVMCM","ZICS")) ; spouse ZIC segment
97 D EN^IVMCM4
98 Q:$D(IVMFERR)
99 ;
100 ; add spouse entry to income relation file (408.22)
101 S IVMSEG=$G(^TMP($J,"IVMCM","ZIRS")) ; spouse ZIR segment
102 D EN^IVMCM5
103 Q:$D(IVMFERR)
104 ;
105ADDCHILD ; add children if not in 408.13
106 S IVMSPCHV="C" ; spouse/child/vet indicator
107 I 'IVMFLGC G ADDV21 ; no dependent children
108 F IVMCTR3=1:1:IVMFLGC D Q:$D(IVMFERR)
109 .S IVMSEG=$G(^TMP($J,"IVMCM","ZDPC",IVMCTR3)) ; child ZDP segment
110 .D INPIEN^IVMCM2
111 .Q:$D(IVMFERR)
112 .;
113 .; add child entry to patient relation file (408.12)
114 .D EN^IVMCM3
115 .Q:$D(IVMFERR)
116 .;
117ADDC21 .; add child entry to individual annual income file (408.21)
118 .S IVMSEG=$G(^TMP($J,"IVMCM","ZICC",IVMCTR3)) ; child ZIC segment
119 .D EN^IVMCM4
120 .Q:$D(IVMFERR)
121 .;
122 .; add entry to income relation file (408.22)
123 .S IVMSEG=$G(^TMP($J,"IVMCM","ZIRC",IVMCTR3)) ; child ZIR segment
124 .D EN^IVMCM5
125 .Q:$D(IVMFERR)
126 .Q
127 Q:$D(IVMFERR)
128 ;
129ADDV21 ; add vet entry to individual annual income file (408.21)
130 ; get vet patient relation ien
131 S DGPRI=+$G(DGREL("V"))
132 S IVMSEG=$G(^TMP($J,"IVMCM","ZICV")) ; vet ZIC segment
133 S IVMSPCHV="V" ; spouse/child/vet indicator
134 D EN^IVMCM4
135 Q:$D(IVMFERR)
136 S DGVINI=DGINI ; vet individual annual income ien
137 ;
138 ; add vet entry to income relation file (408.22)
139 S IVMSEG=$G(^TMP($J,"IVMCM","ZIRV")) ; vet ZIR segment
140 D EN^IVMCM5
141 Q:$D(IVMFERR)
142 S DGVIRI=DGIRI ; vet income relation ien
143 ;
144COMPLETE ; complete means test, copay test, or Long Term Care test
145 ;
146 D EN^IVMCM6
147 ;
148 ; cleanup
149 K DGINI,DGIRI,DGMTDT,DGMTI,DGMTYPT,DGPRI,DGREL,DGVINI,DGVIRI
150 K IVMAR,IVMCEB,IVMCTR3,IVMFERR,IVMFLG1
151 K IVMFLG2,IVMFLG5,IVMHADJ,IVMMTB,IVMPRN
152 K IVMRELN,IVMRELO,IVMREQU,IVMSEG,IVMSPCHV,IVMX
153 Q
154 ;
155LTC ; transmission contains a long term care test (type 4)
156 ;
157 Q:'$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2)
158 I "^1^2^"[("^"_$G(IVMTYPE)_"^") N IVMTYPE
159 S IVMTYPE=4,IVMFUTR=0
160 S IVMMTDT=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,2))
161 S TMSTAMP=$$FMDATE^HLFNC($P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,25))
162 S SOURCE=$P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,22)
163 S IVMLAST=$$LST^DGMTU(DFN,$E(IVMMTDT,1,3)_1231,4)
164 S IVMMTIEN=+IVMLAST ;last LTC test
165 ;deletion indicator sent?
166 I $P($G(^TMP($J,"IVMCM","ZMT4")),HLFS,3)=HLQ D Q
167 .Q:('IVMMTIEN)
168 .S NODE0=$G(^DGMT(408.31,IVMMTIEN,0))
169 .I $$EN^IVMCMD(IVMMTIEN) D
170 ..S RET=$$LST^DGMTU(DFN,DT,IVMTYPE)
171 ..S CODE=$S(($E($P(RET,"^",2),1,3)=$E(DT,1,3)):$P(RET,"^",4),1:"")
172 ..D ADD^IVMCMB(DFN,IVMTYPE,"DELETE LONG TERM CARE TEST",+$G(NODE0),$$GETCODE^DGMTH($P(NODE0,"^",3)),CODE)
173 ;
174 ;check date/time last edited, test date and source - if they match current test then this is a duplicate and does not need to be uploaded
175 N NODE0,NODE2
176 S NODE2=$G(^DGMT(408.31,IVMMTIEN,2)),NODE0=$G(^(0))
177 I TMSTAMP,TMSTAMP=$P(NODE2,"^",2),IVMMTDT=$P(NODE0,"^"),SOURCE=$P(NODE2,"^",5) Q
178 ;
179 D DELTYPE^IVMCMD(DFN,IVMMTDT,4)
180 I $P($G(^TMP($J,"IVMCM","ZMT1")),HLFS,2)!($P($G(^TMP($J,"IVMCM","ZMT2")),HLFS,2)) D Q
181 .S DGMTDT=IVMMTDT,DGMTYPT=IVMTYPE
182 .D ADD^DGMTA
183 .D COMPLETE^IVMCM1
184 D EN^IVMCM1
185 Q
Note: See TracBrowser for help on using the repository browser.