- 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
