| 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
 | 
|---|