IBOUNP2 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
;;2.0;INTEGRATED BILLING;**249**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; IBOTIME appointment time
; IBODIV division
; IBOCLNC clinic
; IBOCTG category vet is in (no=noinsurance,expired,unknow)
; IBOEND2 end of the date range + 30 days
; IBOINS =1 in there is insurance data
; IBORPTD =1 if appt should appear on report
;
LOOPPT ; loops through patients returned from API
N IBOCLNC,IBOTIME,IBOEND2,IBOCTG,IBOINS,IBORPTD,IBONAME S DFN=""
S X1=IBOEND,X2=30 D C^%DTC S IBOEND2=X
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
Q
;
INFO ; looks up info, assumes IBSDDAT
S IBONAME=$P($P(IBSDDAT,"^",4),";",2)
S IBOCLNC=+$P(IBSDDAT,"^",2)
S IBOCLN=$P($P(IBSDDAT,"^",2),";",2) I IBOCLN="" S IBOCLN="NOT KNOWN"
S IBODIV=$P($G(^SC(IBOCLNC,0)),"^",15) S:IBODIV IBODIV=$P($G(^DG(40.8,IBODIV,0)),"^",1) S:IBODIV="" IBODIV="UNKNOWN"
S IBORPTD=0 D UNK:IBOUK,EXP:'IBORPTD&IBOEXP,UNI:'IBORPTD&IBOUI
Q
;
VET(DFN) ; checks if patient is a vet
D ELIG^VADPT
Q $S(VAERR:0,VAEL(4):1,1:0)
;
INDEX ; indexes appointment
S ^TMP("IBOUNP",$J,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
Q
UNK ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE
; was not answered, was answered unknown, and there is no insurance data
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
Q
EXP ; goes in expired category only if there is insurance and
; all of it expired before end of specified period + 30 days
S IBORPTD=0 N T,E D CKINS Q:'IBOINS
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
Q
UNI ; goes in unisured category if there is no insurance data and
; the field COVERED BY HEALTH INSURANCE was answered YES or NO
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
Q
CKINS ; checks if any insurance in insurance multiple of patient record
S IBOINS=0 I $O(^DPT(DFN,.312,0)) S IBOINS=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOUNP2 2271 printed Nov 22, 2024@17:36:20 Page 2
IBOUNP2 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
+1 ;;2.0;INTEGRATED BILLING;**249**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; IBOTIME appointment time
+5 ; IBODIV division
+6 ; IBOCLNC clinic
+7 ; IBOCTG category vet is in (no=noinsurance,expired,unknow)
+8 ; IBOEND2 end of the date range + 30 days
+9 ; IBOINS =1 in there is insurance data
+10 ; IBORPTD =1 if appt should appear on report
+11 ;
LOOPPT ; loops through patients returned from API
+1 NEW IBOCLNC,IBOTIME,IBOEND2,IBOCTG,IBOINS,IBORPTD,IBONAME
SET DFN=""
+2 SET X1=IBOEND
SET X2=30
DO C^%DTC
SET IBOEND2=X
+3 FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if 'DFN
QUIT
IF $$VET(DFN)
SET IBOTIME=$ORDER(^TMP($JOB,"SDAMA301",DFN,0))
SET IBSDDAT=^TMP($JOB,"SDAMA301",DFN,IBOTIME)
DO INFO
if IBORPTD
DO INDEX
+4 QUIT
+5 ;
INFO ; looks up info, assumes IBSDDAT
+1 SET IBONAME=$PIECE($PIECE(IBSDDAT,"^",4),";",2)
+2 SET IBOCLNC=+$PIECE(IBSDDAT,"^",2)
+3 SET IBOCLN=$PIECE($PIECE(IBSDDAT,"^",2),";",2)
IF IBOCLN=""
SET IBOCLN="NOT KNOWN"
+4 SET IBODIV=$PIECE($GET(^SC(IBOCLNC,0)),"^",15)
if IBODIV
SET IBODIV=$PIECE($GET(^DG(40.8,IBODIV,0)),"^",1)
if IBODIV=""
SET IBODIV="UNKNOWN"
+5 SET IBORPTD=0
if IBOUK
DO UNK
if 'IBORPTD&IBOEXP
DO EXP
if 'IBORPTD&IBOUI
DO UNI
+6 QUIT
+7 ;
VET(DFN) ; checks if patient is a vet
+1 DO ELIG^VADPT
+2 QUIT $SELECT(VAERR:0,VAEL(4):1,1:0)
+3 ;
INDEX ; indexes appointment
+1 SET ^TMP("IBOUNP",$JOB,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
+2 QUIT
UNK ; goes in 'unknown' category if the field COVERED BY HEALTH INSURANCE
+1 ; was not answered, was answered unknown, and there is no insurance data
+2 SET IBORPTD=0
NEW T
SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)
IF T="U"!(T="")
DO CKINS
IF 'IBOINS
SET IBOCTG="UNKNOWN"
SET IBORPTD=1
QUIT
+3 QUIT
EXP ; goes in expired category only if there is insurance and
+1 ; all of it expired before end of specified period + 30 days
+2 SET IBORPTD=0
NEW T,E
DO CKINS
if 'IBOINS
QUIT
+3 SET IBORPTD=1
SET IBOCTG="EXPIRED"
FOR T=0:0
SET T=$ORDER(^DPT(DFN,.312,T))
if T'>0
QUIT
SET E=$PIECE($GET(^(T,0)),"^",4)
IF E=""!(E>IBOEND2)
SET IBORPTD=0
QUIT
+4 QUIT
UNI ; goes in unisured category if there is no insurance data and
+1 ; the field COVERED BY HEALTH INSURANCE was answered YES or NO
+2 SET IBORPTD=0
NEW T
SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)
IF T="N"!(T="Y")
DO CKINS
IF 'IBOINS
SET IBOCTG="NO"
SET IBORPTD=1
+3 QUIT
CKINS ; checks if any insurance in insurance multiple of patient record
+1 SET IBOINS=0
IF $ORDER(^DPT(DFN,.312,0))
SET IBOINS=1
+2 QUIT
