[613] | 1 | IBOUNP2 ;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 | ;
|
---|
| 13 | LOOPPT ; 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 | ;
|
---|
| 19 | INFO ; 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 | ;
|
---|
| 27 | VET(DFN) ; checks if patient is a vet
|
---|
| 28 | D ELIG^VADPT
|
---|
| 29 | Q $S(VAERR:0,VAEL(4):1,1:0)
|
---|
| 30 | ;
|
---|
| 31 | INDEX ; indexes appointment
|
---|
| 32 | S ^TMP("IBOUNP",$J,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
|
---|
| 33 | Q
|
---|
| 34 | UNK ; 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
|
---|
| 38 | EXP ; 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
|
---|
| 43 | UNI ; 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
|
---|
| 47 | CKINS ; 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
|
---|