source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEDE3.m@ 1751

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1IBCNEDE3 ;DAOU/DJW - NONVERINS DATA EXTRACT ;18-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;**Program Description**
6 ; This program finds veterans who have been seen within a
7 ; specified date range that have active insurance records which has
8 ; not been verified recently.
9 ; Periodically check for stop request for background task
10 ;
11 Q ; program can not be called directly
12 ;
13EN ; Loop through designated cross-references for updates
14 ; (Non verified insurance)
15 ;
16 ; Initialize
17 NEW DIC,DA,X,Y,DLAYGO,DINUM,DTOUT,DFN,FRESHDT,IBD,IBPM,IBPMD
18 NEW IEN,MAXCNT,IBCNECNT,EACTIVE,XDAYS,YDAYS,TDT,VI,IBBDT,IBEDT
19 NEW VINCON,VNOK,SRVICEDT,RESULT,PAYER,PAYERID,ARRAY,ERROR,SUPPBUFF
20 NEW TRANSNO,IBQUERY,PTN,INSNAME,IBCNETOT,SID,SIDACT,SIDDATA,SCNT5
21 NEW SIDARRAY,SIDCNT,DISYS,DGPMDT,AUPNDT,II
22 ;
23 S IEN="",IBCNECNT=0
24 ; Initialize count for periodic TaskMan check
25 S IBCNETOT=0
26 ;
27 ; Get site parameter settings for non-verified ins. extract
28 S EACTIVE=$$SETTINGS^IBCNEDE7(3)
29 I 'EACTIVE G EXIT ; Quit if extract not active
30 S XDAYS=$P(EACTIVE,U,2)
31 S YDAYS=$P(EACTIVE,U,3)
32 S MAXCNT=$P(EACTIVE,U,4)
33 S:MAXCNT="" MAXCNT=9999999999
34 S SUPPBUFF=$P(EACTIVE,U,5)
35 ;
36 ; Check for Date Last Treated and get DFN's
37 S IBBDT=$$FMADD^XLFDT(DT,-XDAYS),IBEDT=DT
38 ;
39 ; * main control
40 ;
41 S IBD=IBBDT-.0001
42 K ^TMP("IBCNEDE3",$J,"PTS")
43 F II=1:1 D Q:(IBD="")!(IBD\1>IBEDT)!(IBCNECNT'<MAXCNT)!($G(ZTSTOP))
44 . S DGPMDT=$O(^DGPM("ATT3",IBD)),AUPNDT=$O(^AUPNVSIT("B",IBD))
45 . I (AUPNDT="")!((DGPMDT\1)<(AUPNDT\1)) S IBD=DGPMDT
46 . I (DGPMDT="")!((DGPMDT\1)>(AUPNDT\1)) S IBD=AUPNDT
47 . I (IBD\1>IBEDT)!(IBD="") Q
48 . ;
49 . K ^TMP("IBJDI51",$J)
50 . D INP(IBD) ; sets up ^TMP("IBJDI51",$J)
51 . I $G(ZTSTOP) Q
52 . D OUTP(IBD) ; sets up ^TMP("IBJDI51",$J)
53 . I $G(ZTSTOP) Q
54 . ;D REST(IBBDT-.0001,IBEDT) ; sets up ^TMP("IBJDI51",$J)
55 . D PROCESS
56 . I $G(ZTSTOP) Q
57 . S IBD=($$FMADD^XLFDT(IBD,+1))-.0001
58 ;
59EXIT ;
60 K VINS,^TMP("IBJDI51",$J),^TMP("IBCNEDE3",$J,"PTS") ; clean up
61 ;
62 Q
63 ; * end of routine processing
64 ;===========================================
65INP(DATE) ; Find inpatients for that date (we want most recent encounter)
66 NEW IBD,IBPM,IBPMD,DFN
67 S IBD=DATE-.0001
68 F S IBD=$O(^DGPM("ATT3",IBD)) Q:(IBD="")!(IBD\1>DATE) D Q:$G(ZTSTOP)
69 . S IBPM=0 F S IBPM=$O(^DGPM("ATT3",IBD,IBPM)) Q:IBPM="" D Q:$G(ZTSTOP)
70 .. ; Update count for periodic check
71 .. S IBCNETOT=IBCNETOT+1
72 .. ; Check for request to stop background job, periodically
73 .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
74 .. ;
75 .. S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD
76 .. S DFN=+$P(IBPMD,U,3) Q:'DFN
77 .. I $P($G(^DPT(DFN,0)),U,21) Q ; Exclude if test patient
78 .. Q:$D(^TMP("IBCNEDE3",$J,"PTS",DFN,"INP")) ; already processed
79 .. S ^TMP("IBCNEDE3",$J,"PTS",DFN,"INP",IBD)=""
80 .. D PROC^IBJDI5(DFN,"*",IBD)
81 Q
82 ;
83OUTP(DATE) ; Find outpatients treated for this date (most recent encounter)
84 NEW IBD,IEN,DFN
85 S IBD=DATE-.0001
86 F S IBD=$O(^AUPNVSIT("B",IBD)) Q:(IBD="")!(IBD\1>DATE) D Q:$G(ZTSTOP)
87 . S IEN=""
88 . F S IEN=$O(^AUPNVSIT("B",IBD,IEN)) Q:IEN="" D Q:$G(ZTSTOP)
89 .. ; Update count for periodic check
90 .. S IBCNETOT=IBCNETOT+1
91 .. ; Check for request to stop background job, periodically
92 .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
93 .. ;
94 .. S DFN=$P($G(^AUPNVSIT(IEN,0)),U,5)
95 .. Q:DFN=""
96 .. I $P($G(^DPT(DFN,0)),U,21) Q ; Exclude if test patient
97 .. Q:$D(^TMP("IBCNEDE3",$J,"PTS",DFN,"OUTP")) ; already processed
98 .. S ^TMP("IBCNEDE3",$J,"PTS",DFN,"OUTP",IBD)=""
99 .. ; Capture the most recent (last) encounter date
100 .. I $G(^TMP("IBJDI51",$J,DFN))<(IBD\1) D PROC^IBJDI5(DFN,"",IBD)
101 Q
102 ;
103REST(STARTDT,ENDDT) ; Check to see if there was a more recent inpatient
104 ; or outpatient encounter for this patient.
105 ;
106 NEW IBPM,IBPMD,IBD,DFN
107 S DFN=0
108 F S DFN=$O(^TMP("IBJDI51",$J,DFN)) Q:DFN="" D
109 . ;
110 . ; inpatients
111 . S IBPM=0 F S IBPM=$O(^DGPM("C",DFN,IBPM)) Q:IBPM="" D
112 .. S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD
113 .. S IBD=$P(IBPMD,U,1) I ((IBD\1)<STARTDT)!((IBD\1)>ENDDT) Q
114 .. Q:$D(^TMP("IBJDI51",$J,"PTS",DFN,"INP",IBD)) ;already checked
115 .. S ^TMP("IBJDI51",$J,"PTS",DFN,"INP",IBD)=""
116 .. ; Capture the most recent (last) encounter date
117 .. I $G(^TMP("IBJDI51",$J,DFN))<(IBD\1) D PROC^IBJDI5(DFN,"*",IBD)
118 . ;
119 . ; outpatients
120 . S IBD="" F S IBD=$O(^AUPNVSIT("AA",DFN,IBD)) Q:IBD="" D
121 .. I ((IBD\1)<STARTDT)!((IBD\1)>ENDDT) Q
122 .. Q:$D(^TMP("IBJDI51",$J,"PTS",DFN,"OUTP",IBD)) ;already checked
123 .. S ^TMP("IBJDI51",$J,"PTS",DFN,"OUTP",IBD)=""
124 .. ; Capture the most recent (last) encounter date
125 .. I $G(^TMP("IBJDI51",$J,DFN))<(IBD\1) D PROC^IBJDI5(DFN,"",IBD)
126 ;
127 K ^TMP("IBCNEDE3",$J,"PTS") ; clean up - no longer needed
128 Q
129 ;
130PROCESS ; Get insurance for each patient
131 S DFN=0 F S DFN=$O(^TMP("IBJDI51",$J,DFN)) Q:'DFN D Q:IBCNECNT'<MAXCNT!$G(ZTSTOP)
132 . ; Update count for periodic check
133 . S IBCNETOT=IBCNETOT+1
134 . ; Check for request to stop background job, periodically
135 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
136 . ;
137 . S SRVICEDT=$P(^TMP("IBJDI51",$J,DFN),U)
138 . S FRESHDT=$$FMADD^XLFDT(SRVICEDT,-YDAYS)
139 . K VINS
140 . D ALL^IBCNS1(DFN,"VINS",3)
141 . ;
142 . I $G(VINS(0))="" Q ; no active insurance
143 . ;
144 . S VI=0 F S VI=$O(VINS(VI)) Q:VI=""!(IBCNECNT'<MAXCNT) D
145 .. S VINCON=$P(VINS(VI,0),U)
146 .. ;
147 .. ;Check for ins. companies to exclude (i.e. Medicare/Medicaid)
148 .. S INSNAME=$P($G(^DIC(36,VINCON,0)),U)
149 .. I $$EXCLUDE^IBCNEUT4(INSNAME) Q
150 .. ;
151 .. ;Check for Ins. Company/Payer problems
152 .. S RESULT=$$INSERROR^IBCNEUT3("I",VINCON)
153 .. ;
154 .. I $P(RESULT,U)'="" D BUFF Q ; error encountered
155 .. ;
156 .. S PAYER=$P(RESULT,U,2),PAYERID=$P(RESULT,U,3) ; Payer IEN & Payer ID
157 .. I 'PAYER!(PAYERID="") Q
158 .. ;
159 .. ; Update service date and freshness date based on payer allowed
160 .. ; date range
161 .. D UPDDTS^IBCNEDE6(PAYER,.SRVICEDT,.FRESHDT)
162 .. ;
163 .. ; Update service dates for inquiries to be transmitted
164 .. D TQUPDSV^IBCNEUT5(DFN,PAYER,SRVICEDT)
165 .. ;
166 .. ; Check for outstanding/current entries in File 365.1
167 .. I '$$ADDTQ^IBCNEUT5(DFN,PAYER,SRVICEDT,YDAYS) Q
168 .. K SIDARRAY
169 .. S SIDDATA=$$SIDCHK^IBCNEDE5(PAYER,DFN,,.SIDARRAY,FRESHDT)
170 .. S SIDACT=$P(SIDDATA,U),SIDCNT=$P(SIDDATA,U,2)
171 .. S SCNT5=$S(SIDACT=5:1,1:"")
172 .. ;
173 .. I SIDACT=3 D Q
174 ... I 'SUPPBUFF,'$$BFEXIST^IBCNEUT5(DFN,INSNAME) D PT^IBCNEBF(DFN,VI,18,"",1)
175 .. I IBCNECNT+SCNT5+SIDCNT>MAXCNT S IBCNECNT=MAXCNT Q ;quit if TQ entries>MAXCNT
176 .. S SID=""
177 .. F S SID=$O(SIDARRAY(SID)) Q:SID="" D SET($P(SID,"_"),$P(SID,"_",2))
178 .. I SIDACT=4!(SIDACT=5) D SET("","")
179 Q
180 ;
181SET(SID,INR) ; Call function to set IIV TRANSMISSION QUEUE file #365.1
182 NEW DATA1,DATA2,TQIEN
183 ;
184 ; The hard coded '1' in the 3rd piece of DATA1 sets the Transmission
185 ; status of file 365.1 to "Ready to Transmit"
186 S DATA1=DFN_U_PAYER_U_1_U_""_U_SID_U_FRESHDT
187 ;
188 ; The hardcoded '3' in the 1st piece of DATA2 is the value to tell
189 ; the file 365.1 that it is the non-verified extract.
190 S DATA2=3_U_"V"_U_SRVICEDT_U_INR
191 ;
192 S TQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2)
193 I TQIEN'="" S IBCNECNT=IBCNECNT+1
194 ;
195 Q
196BUFF ; Create new buffer entry, if one doesn't already exist, with a
197 ; bang symbol
198 I SUPPBUFF Q ; determine if we suppress buffer entries
199 I '$$BFEXIST^IBCNEUT5(DFN,INSNAME) D PT^IBCNEBF(DFN,VI,$P(RESULT,U),"",1)
200 Q
201 ;
Note: See TracBrowser for help on using the repository browser.