IBOUNP2 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
; 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
LOOPCLNC ; loops through selected clinics
N IBOCLNC,IBOTIME,IBOEND2,IBOCTG,IBOINS,IBORPTD,IBONAME S IBOCLNC=""
S X1=IBOEND,X2=30 D C^%DTC S IBOEND2=X
I VAUTC=1 F S IBOCLNC=$O(^SC("AC","C",IBOCLNC)) Q:'IBOCLNC D LOOPAPPT
I VAUTC'=1 F S IBOCLNC=$O(VAUTC(IBOCLNC)) Q:'IBOCLNC D LOOPAPPT
Q
LOOPAPPT ; loops through appointments for a selected clinic
N J,R,IBOCLN,IBODIV I $D(^SC(IBOCLNC,0)) D
.S IBODIV=$P($G(^SC(IBOCLNC,0)),"^",15) S:IBODIV IBODIV=$P($G(^DG(40.8,IBODIV,0)),"^",1) S:IBODIV="" IBODIV="UNKNOWN"
.N IBOCLN S IBOCLN=$P($G(^SC(IBOCLNC,0)),"^",1) I IBOCLN="" S IBOCLN="NOT KNOWN"
.F IBOTIME=IBOBEG-.0001:0 S IBOTIME=$O(^SC(IBOCLNC,"S",IBOTIME)) Q:'IBOTIME!(IBOTIME>(IBOEND+.99)) F J=0:0 S J=$O(^SC(IBOCLNC,"S",IBOTIME,1,J)) Q:J<1 I $D(^SC(IBOCLNC,"S",IBOTIME,1,J,0)) D
.. S R=^(0),DFN=+R
.. I $P(R,"^",9)'="C",$D(^DPT(DFN,"S",IBOTIME,0)),$P(^(0),"^",2)']"" S IBOQUIT=0 D DONE,VET:'IBOQUIT,STATUS:'IBOQUIT Q:IBOQUIT S IBORPTD=0 D UNK:IBOUK,EXP:'IBORPTD&IBOEXP,UNI:'IBORPTD&IBOUI,INDEX:IBORPTD
Q
VET ; checks if patient is a vet
S IBOQUIT=1 D ELIG^VADPT Q:VAERR S:VAEL(4) IBOQUIT=0
Q
DONE ; checks if patient already on report
S:$D(^TMP($J,"PATIENTS",DFN)) IBOQUIT=1
Q
STATUS ; checks if appt status="",otherwise should not be on report
S:($P($G(^DPT(DFN,"S",IBOTIME,0)),"^",2)]"") IBOQUIT=1
Q
INDEX ; indexes appointment,also indexs vet so he won't be reported
S IBONAME=$P($G(^DPT(DFN,0)),"^",1) Q:IBONAME'[""
S ^TMP($J,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
S ^TMP($J,"PATIENTS",DFN)=""
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
IBOUNP2 ;ALB/CJM - OUTPATIENT INSURANCE REPORT ;JAN 25,1992
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ; IBOTIME appointment time
+3 ; IBODIV division
+4 ; IBOCLNC clinic
+5 ; IBOCTG category vet is in (no=noinsurance,expired,unknow)
+6 ; IBOEND2 end of the date range + 30 days
+7 ; IBOINS =1 in there is insurance data
+8 ; IBORPTD =1 if appt should appear on report
LOOPCLNC ; loops through selected clinics
+1 NEW IBOCLNC,IBOTIME,IBOEND2,IBOCTG,IBOINS,IBORPTD,IBONAME
SET IBOCLNC=""
+2 SET X1=IBOEND
SET X2=30
DO C^%DTC
SET IBOEND2=X
+3 IF VAUTC=1
FOR
SET IBOCLNC=$ORDER(^SC("AC","C",IBOCLNC))
IF 'IBOCLNC
QUIT
DO LOOPAPPT
+4 IF VAUTC'=1
FOR
SET IBOCLNC=$ORDER(VAUTC(IBOCLNC))
IF 'IBOCLNC
QUIT
DO LOOPAPPT
+5 QUIT
LOOPAPPT ; loops through appointments for a selected clinic
+1 NEW J,R,IBOCLN,IBODIV
IF $DATA(^SC(IBOCLNC,0))
Begin DoDot:1
+2 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"
+3 NEW IBOCLN
SET IBOCLN=$PIECE($GET(^SC(IBOCLNC,0)),"^",1)
IF IBOCLN=""
SET IBOCLN="NOT KNOWN"
+4 FOR IBOTIME=IBOBEG-.0001:0
SET IBOTIME=$ORDER(^SC(IBOCLNC,"S",IBOTIME))
IF 'IBOTIME!(IBOTIME>(IBOEND+.99))
QUIT
FOR J=0:0
SET J=$ORDER(^SC(IBOCLNC,"S",IBOTIME,1,J))
IF J<1
QUIT
IF $DATA(^SC(IBOCLNC,"S",IBOTIME,1,J,0))
Begin DoDot:2
+5 SET R=^(0)
SET DFN=+R
+6 IF $PIECE(R,"^",9)'="C"
IF $DATA(^DPT(DFN,"S",IBOTIME,0))
IF $PIECE(^(0),"^",2)']""
SET IBOQUIT=0
DO DONE
IF 'IBOQUIT
DO VET
IF 'IBOQUIT
DO STATUS
IF IBOQUIT
QUIT
SET IBORPTD=0
IF IBOUK
DO UNK
IF 'IBORPTD&IBOEXP
DO EXP
IF 'IBORPTD&IBOUI
DO UNI
IF IBORPTD
DO INDEX
End DoDot:2
End DoDot:1
+7 QUIT
VET ; checks if patient is a vet
+1 SET IBOQUIT=1
DO ELIG^VADPT
IF VAERR
QUIT
IF VAEL(4)
SET IBOQUIT=0
+2 QUIT
DONE ; checks if patient already on report
+1 IF $DATA(^TMP($JOB,"PATIENTS",DFN))
SET IBOQUIT=1
+2 QUIT
STATUS ; checks if appt status="",otherwise should not be on report
+1 IF ($PIECE($GET(^DPT(DFN,"S",IBOTIME,0)),"^",2)]"")
SET IBOQUIT=1
+2 QUIT
INDEX ; indexes appointment,also indexs vet so he won't be reported
+1 SET IBONAME=$PIECE($GET(^DPT(DFN,0)),"^",1)
IF IBONAME'[""
QUIT
+2 SET ^TMP($JOB,IBOCTG,IBODIV,IBOCLN,IBONAME,DFN)=IBOTIME
+3 SET ^TMP($JOB,"PATIENTS",DFN)=""
+4 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
