source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOUNP2.m@ 1297

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1IBOUNP2 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
2 ;;2.0;INTEGRATED BILLING;**249**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; IBOTIME appointment time
6 ; IBODIV division
7 ; IBOCLNC clinic
8 ; IBOCTG category vet is in (no=noinsurance,expired,unknow)
9 ; IBOEND2 end of the date range + 30 days
10 ; IBOINS =1 in there is insurance data
11 ; IBORPTD =1 if appt should appear on report
12 ;
13LOOPPT ; loops through patients returned from API
14 N IBOCLNC,IBOTIME,IBOEND2,IBOCTG,IBOINS,IBORPTD,IBONAME S DFN=""
15 S X1=IBOEND,X2=30 D C^%DTC S IBOEND2=X
16 F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:'DFN I $$VET(DFN) S IBOTIME=$O(^TMP($J,"SDAMA301",DFN,0)),IBSDDAT=^TMP($J,"SDAMA301",DFN,IBOTIME) D INFO,INDEX:IBORPTD
17 Q
18 ;
19INFO ; looks up info, assumes IBSDDAT
20 S IBONAME=$P($P(IBSDDAT,"^",4),";",2)
21 S IBOCLNC=+$P(IBSDDAT,"^",2)
22 S IBOCLN=$P($P(IBSDDAT,"^",2),";",2) I IBOCLN="" S IBOCLN="NOT KNOWN"
23 S IBODIV=$P($G(^SC(IBOCLNC,0)),"^",15) S:IBODIV IBODIV=$P($G(^DG(40.8,IBODIV,0)),"^",1) S:IBODIV="" IBODIV="UNKNOWN"
24 S IBORPTD=0 D UNK:IBOUK,EXP:'IBORPTD&IBOEXP,UNI:'IBORPTD&IBOUI
25 Q
26 ;
27VET(DFN) ; checks if patient is a vet
28 D ELIG^VADPT
29 Q $S(VAERR:0,VAEL(4):1,1:0)
30 ;
31INDEX ; indexes appointment
32 S ^TMP("IBOUNP",$J,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
33 Q
34UNK ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE
35 ; was not answered, was answered unknown, and there is no insurance data
36 S IBORPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="U"!(T="") D CKINS I 'IBOINS S IBOCTG="UNKNOWN",IBORPTD=1 Q
37 Q
38EXP ; goes in expired category only if there is insurance and
39 ; all of it expired before end of specified period + 30 days
40 S IBORPTD=0 N T,E D CKINS Q:'IBOINS
41 S IBORPTD=1,IBOCTG="EXPIRED" F T=0:0 S T=$O(^DPT(DFN,.312,T)) Q:T'>0 S E=$P($G(^(T,0)),"^",4) I E=""!(E>IBOEND2) S IBORPTD=0 Q
42 Q
43UNI ; goes in unisured category if there is no insurance data and
44 ; the field COVERED BY HEALTH INSURANCE was answered YES or NO
45 S IBORPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="N"!(T="Y") D CKINS I 'IBOINS S IBOCTG="NO",IBORPTD=1
46 Q
47CKINS ; checks if any insurance in insurance multiple of patient record
48 S IBOINS=0 I $O(^DPT(DFN,.312,0)) S IBOINS=1
49 Q
Note: See TracBrowser for help on using the repository browser.