source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMPTRN.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 7.3 KB
Line 
1IVMPTRN ;ALB/MLI,SEK,RTK,BRM,BAJ - IVM BACKGROUND JOB/TRANSMISSIONS TO IVM CENTER; 10/28/2005
2 ;;2.0;INCOME VERIFICATION MATCH;**1,9,11,12,17,28,34,74,79,89,105**;JUL 8,1996;Build 2
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine is run nightly to send HL7 messages to the IVM Center for
6 ; processing.
7 ;
8BGJ ; - IVM Nightly Background Job
9 ;
10 ;for tests being held for the future, make them primary if now effective
11 D FUTUREMT,FUTURERX
12 ;
13 ; - retransmit enrollment/eligibility queries with no reply
14 D BATCH^DGENQRY1
15 ;
16 ; - retransmit income test (financial) queries with no reply
17 D MONITOR^IVMCQ2
18 ;
19 ; - current year and previous year
20 S IVMCURYR=$$LYR^DGMTSCU1(DT),IVMPREYR=$$LYR^DGMTSCU1(IVMCURYR)
21 ;
22 ;
23 ; - Master Query Processing
24 ;
25 ; - respond to Master Query for previous year, if necessary
26 S IVMREC=$$QRY(IVMPREYR) I IVMREC D RESP(IVMPREYR,+IVMREC),END
27 ;
28 ; - respond to Master Query for current year, if necessary
29 S IVMREC=$$QRY(IVMCURYR) I IVMREC D RESP(IVMCURYR,+IVMREC),END
30 ;
31 ; - send regular 'nightly' transmissions
32 D REG,END
33 ;
34 ; - perform retransmission processing
35 D ENTRY^IVMPTRN4,END
36 ;
37 ; - process billing activity
38 D EN^IVMPTRN5
39 ;
40 ; - auto-upload address changes from #301.5 if >14 days old
41 ; - auto-delete non address changes from #301.5 if >30 days old
42 N ADDRDT S ADDRDT(0)=30,ADDRDT(1)=14 D EN^IVMLDEMC(.ADDRDT)
43 ;
44END ; - cleanup
45 I $D(ZTQUEUED) S ZTREQ="@"
46 K DA,DFN,DIE,DIK,DR,IVMCT,IVMDA,IVMDT,IVMGTOT,IVMINCYR,IVMINS,IVMMTDT
47 K IVMNODE,IVMPAT,IVMPID,IVMQDT,IVMREC,IVMSTAT,X,%,VAFPID,IVMPREYR,IVMIY
48 D CLEAN^IVMUFNC
49 K ^TMP($J,"CC")
50 Q
51 ;
52REG ; Creates FULL query transmission for patient's
53 ; that exist in file (#301.5) "ATR" x-ref
54 ;
55 ;
56 ; - initialize variables for HL7/IVM
57 S HLMTN="ORU"
58 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" "_HLMTN_"-Z07 SERVER"
59 S HLEID=$O(^ORD(101,"B",HLEID,0))
60 K ^TMP($J,"CC") ;refresh Consistency Check counter
61 D INIT^IVMUFNC(HLEID,.HL)
62 ;
63 ; - roll thru ATR x-ref for patients that require transmission
64 K IVMQUERY("LTD"),IVMQUERY("OVIS") ;Variables needed to open/close last visit date and outpt visit QUERIES
65 S IVMIY=0
66 F S IVMIY=$O(^IVM(301.5,"ATR",0,IVMIY)) Q:'IVMIY D
67 .S IVMDA=0
68 .F S IVMDA=$O(^IVM(301.5,"ATR",0,IVMIY,IVMDA)) Q:'IVMDA D
69 ..;
70 ..N EVENTS
71 ..; - get node, income year, dfn
72 ..S IVMNODE=$G(^IVM(301.5,+IVMDA,0)),IVMDT=+$P(IVMNODE,"^",2),DFN=+IVMNODE
73 ..I 'DFN!'IVMDT Q
74 ..;
75 ..Q:($$STATUS^IVMPLOG(IVMDA,.EVENTS)=1)
76 ..;
77 ..S IVMMTDT=$P($$LST^DGMTU(DFN,($E(IVMDT,1,3)+1)_"1231.9999"),"^",2)
78 ..;
79 ..; - prepare FULL transmission
80 ..D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,,,,.IVMQUERY)
81 ;
82 ; After all transmissions send Bulletin of inconsistency check totals
83 D EN^IVMPBUL
84 ;
85 F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
86 ; - transmit remaining records
87 D
88 .N IVMEVENT
89 .; event code for Full Data Transmission
90 .S IVMEVENT="Z07"
91 .D FILE^IVMPTRN3
92 Q
93 ;
94RESP(IVMINCYR,IVMREC) ; Response to the Master Query.
95 ;
96 ; Input: IVMINCYR - The income year for which the query was sent
97 ; IVMREC - Internal entry number of query to be updated
98 ;
99 N DFN,IVMDA,IVMMTDT,DA,DR,DIE,EVENTS
100 ;
101 ; - initialize variables for HL7/IVM
102 S HLMTN="ORF"
103 S HLEID="VAMC "_$P($$SITE^VASITE,"^",3)_" "_HLMTN_"-Z07 SERVER"
104 S HLEID=$O(^ORD(101,"B",HLEID,0))
105 D INIT^IVMUFNC(HLEID,.HL)
106 ;
107 ; - roll thru AYR x-ref
108 F DFN=0:0 S DFN=$O(^IVM(301.5,"AYR",IVMINCYR,DFN)) Q:'DFN D
109 .F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,"AYR",IVMINCYR,DFN,IVMDA)) Q:'IVMDA D
110 ..;
111 ..; - check for STOP FLAG in file #301.5.
112 ..I '$$CLOSED^IVMPLOG(IVMDA) D
113 ...;
114 ...; if means test was deleted, -10000 could be entered as income year
115 ...; in ^IVM(301.5. close case if deleted.
116 ...S IVMMTDT=$P($$LST^DGMTU(DFN,($E(IVMINCYR,1,3)+1)_"1231.9999"),"^",2)
117 ...I IVMMTDT="" D CLOSE^IVMPTRN1(IVMINCYR,DFN,1,3) Q
118 ...;
119 ...;get EVENTS() array
120 ...I $$STATUS^IVMPLOG(+IVMDA,.EVENTS)
121 ...;
122 ...; - prepare FULL transmission
123 ...; note: 6th parameter is IVMFLL (=1 to include MSA segment)
124 ...D FULL^IVMPTRN7(DFN,IVMMTDT,.EVENTS,.IVMCT,.IVMGTOT,1,,$G(IVMREC),.IVMQUERY)
125 ;
126 ; - transmit remaining records
127 D
128 .N IVMEVENT
129 .; event code for Full Data Transmission
130 .S IVMEVENT="Z07"
131 .D FILE1^IVMPTRN3 ; added for v1.6 because of MSA segment (note: the original call was to FILE^IVMPTRN3)
132 ;
133 ;
134 ; - update multiple in file #301.9. Stuff (.03) field with date/time
135 ; of FULL query transmission.
136 S DIE="^IVM(301.9,1,10,",DA=+IVMREC,DA(1)=1,DR=".03////"_$$NOW^XLFDT D ^DIE
137 Q
138 ;
139QRY(YEAR) ; See if Master Query has been satisfied for YEAR.
140 ; Input: YEAR - The income year being checked
141 ;
142 ; Output: 1^2, where 1 = 0, if query does not need a response
143 ; >0, if query needs a response (value
144 ; equal to ien of sub-file entry
145 ; in #301.9
146 ; 2 = 0, if the request has not been received
147 ; 1, if the request has been received
148 N IVM,X,Y,Z
149 I '$G(YEAR) S X="0^0" G QRYQ
150 S Y=$O(^IVM(301.9,1,10,"AB",YEAR,"")) I 'Y S X="0^0" G QRYQ
151 S IVM=$O(^IVM(301.9,1,10,"AB",YEAR,Y,0)) I 'IVM S X="0^0" G QRYQ
152 S Z=$P($G(^IVM(301.9,1,10,+IVM,0)),"^",3)
153 S X=$S(Z:0,1:IVM)_"^1"
154QRYQ Q X
155 ;
156FUTUREMT ;
157 ;Find future tests, and if now effective then make them primary. Will
158 ;call the MT event driver unless NOT required, in which case the status
159 ;will have the status will be changed to NO LONGER REQUIRED
160 ;and may auto-create a Rx copay test
161 ;
162 N FDATE,IVMPAT,MTIEN,NODE,DFN,DATA
163 ;
164 S FDATE=0
165 F S FDATE=$O(^IVM(301.5,"AC",FDATE)) Q:('FDATE) Q:(FDATE>DT) D
166 .S IVMPAT=0
167 .F S IVMPAT=$O(^IVM(301.5,"AC",FDATE,IVMPAT)) Q:'IVMPAT D
168 ..S MTIEN=$O(^IVM(301.5,"AC",FDATE,IVMPAT,""),-1)
169 ..I '$$FUTURECK("AC",FDATE,IVMPAT,MTIEN) K ^IVM(301.5,"AC",FDATE,IVMPAT,MTIEN)
170 ..K DATA S DATA(.06)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
171 ..S DFN=+$G(^IVM(301.5,IVMPAT,0))
172 ..I DFN S NODE=$$LST^DGMTU(DFN,DT_.9999,1) I $E($P(NODE,"^",2),1,3)=$E(DT,1,3),$P(NODE,"^",4)'="","R"'=$P(NODE,"^",4) K ^IVM(301.5,"AC",FDATE,IVMPAT,MTIEN) Q
173 ..D MTPRIME^DGMTU4(MTIEN)
174 Q
175 ;
176FUTURERX ;
177 ;Find future COPAY tests, and if now effective then make it primary.
178 ;Will change the status to NO LONGER APPLICABLE if the vet is not
179 ;subject to pharmacy copayments
180 ;
181 N FDATE,IVMPAT,MTIEN,NODE,DFN,DATA
182 ;
183 S FDATE=0
184 F S FDATE=$O(^IVM(301.5,"AD",FDATE)) Q:('FDATE) Q:(FDATE>DT) D
185 .S IVMPAT=0
186 .F S IVMPAT=$O(^IVM(301.5,"AD",FDATE,IVMPAT)) Q:'IVMPAT D
187 ..S MTIEN=$O(^IVM(301.5,"AD",FDATE,IVMPAT,""),-1)
188 ..I '$$FUTURECK("AD",FDATE,IVMPAT,MTIEN) K ^IVM(301.5,"AD",FDATE,IVMPAT,MTIEN)
189 ..K DATA S DATA(.07)="" I $$UPD^DGENDBS(301.5,IVMPAT,.DATA)
190 ..S DFN=+$G(^IVM(301.5,IVMPAT,0))
191 ..I DFN S NODE=$$LST^DGMTU(DFN,DT_.9999,2) I $E($P(NODE,"^",2),1,3)=$E(DT,1,3),$P(NODE,"^",4)'="" K ^IVM(301.5,"AD",FDATE,IVMPAT,MTIEN) Q
192 ..D RXPRIME^DGMTU4(MTIEN)
193 Q
194 ;
195FUTURECK(TYPE,FDATE,IVMPAT,MTIEN) ;
196 ; Check the Future MT or CP xref for a valid income test entry,
197 ; and Delete all invalid xref entries.
198 N VALID,MTREC S VALID=1,MTREC=0
199 ;
200 ; Remove duplicate entries from cross reference, leaving last entry
201 F S MTREC=$O(^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)) Q:(MTREC=MTIEN!('MTREC)) K ^IVM(301.5,TYPE,FDATE,IVMPAT,MTREC)
202 ;
203 I '$D(^IVM(301.5,IVMPAT,0)) S VALID=0 Q VALID
204 I '$D(^DGMT(408.31,MTIEN,0)) S VALID=0 Q VALID
205 I FDATE'=+(^DGMT(408.31,MTIEN,0)) S VALID=0 Q VALID
206 ;
207 Q VALID
Note: See TracBrowser for help on using the repository browser.