IBOUNP5 ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
; TIME appointment or admission time time
; CTG category vet is in (no,expired,unknow)
; INS =1 in there is insurance data
; RPTD =1 if appt should appear on report
; IBOPICK ="D" if the user chose to enter a date range, otherwise ="C"
; for the current date
; END2 30 days into the future, starting either from the curren date
; or END, depending on IBOPICK
LOOP ; loops through inpatients
N DIV,DFN,PAT,TIME,CTG,INS,QUIT,RPTD,END2
I IBOPICK="C" D LOOP1
I IBOPICK="D" D LOOP2
Q
LOOP1 ; finds current admissions for selected divisions
N TDY,WRD,WRDN,ADM,DTH,R S WRD=0
D NOW^%DTC S (TDY,X1)=X,X2=30 D C^%DTC S END2=X
F S WRD=$O(^DIC(42,WRD)) Q:WRD'>0 S R=$G(^(WRD,0)),DIV=$P(R,"^",11),WRDN=$P(R,"^",1) D DIV I 'QUIT&(WRDN]"") D
. S DFN=0 F S DFN=$O(^DPT("CN",WRDN,DFN)) Q:DFN'>0 S ADM=^(DFN) I ADM]"",$P($G(^DGPM(+ADM,0)),"^",2)=1 S TIME=+^(0),DTH=+$G(^DPT(DFN,.35)) D:'DTH!((DTH\1)=TDY) PROC
Q
LOOP2 ; finds admissions during selected date range for selected divisions
N WRD0,WRDN
N T S X1=IBOEND,X2=30 D C^%DTC S END2=X
S T=(IBOBEG-.0001)
F S T=$O(^DGPM("AMV1",T)) Q:'T!(T>(IBOEND+.99)) D
.S DFN=0 F S DFN=$O(^DGPM("AMV1",T,DFN)) Q:'DFN S DIV="",DIV=$O(^DGPM("AMV1",T,DFN,DIV)) Q:DIV'>0 S WRD0=$G(^DIC(42,+$P($G(^DGPM(DIV,0)),U,6),0)),DIV=+$P(WRD0,U,11),WRDN=$P(WRD0,"^"),TIME=T,QUIT=0 D:DIV PROC
Q
PROC ;
D DIV:IBOPICK'="C",DONE:'QUIT,VET:'QUIT S RPTD=0 D:'QUIT UNK:IBOUK,EXP:'RPTD&IBOEXP,UNI:'RPTD&IBOUI,INDEX:RPTD
Q
VET ; checks if patient is a vet
S QUIT=1 D ELIG^VADPT Q:VAERR S:VAEL(4) QUIT=0
Q
DONE ; checks if patient already on report
S:$D(^TMP($J,"PATIENTS",DFN)) QUIT=1
Q
INDEX ; indexes appointment,also indexs vet so he won't be reported twice
N NAME,D
S D=""
I DIV S D=$P($G(^DG(40.8,DIV,0)),"^",1)
I D="" S D="NOT KNOWN"
I WRDN="" S WRDN="NOT KNOWN"
S NAME=$P($G(^DPT(DFN,0)),"^",1) Q:NAME'[""
S ^TMP($J,CTG,D,$S(IBOBYWRD:WRDN,1:"ALL WARDS"),NAME,DFN)=TIME_"^"_WRDN
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 RPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="U"!(T="") D CKINS I 'INS S CTG="UNKNOWN",RPTD=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 RPTD=0 N T,E D CKINS I 'INS Q
S RPTD=1,CTG="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>END2) S RPTD=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 RPTD=0 N T S T=$P($G(^DPT(DFN,.31)),"^",11) I T="N"!(T="Y") D CKINS I 'INS S CTG="NO",RPTD=1
Q
CKINS ; checks if any insurance in insurance multiple of patient record
S INS=0 I $O(^DPT(DFN,.312,0)) S INS=1
Q
DIV ; checks if the division is on the list VAUTD()
S QUIT=0 I VAUTD=1 Q
I 'DIV S QUIT=1 Q
I '$D(VAUTD(+DIV)) S QUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOUNP5 3156 printed Dec 13, 2024@02:26:19 Page 2
IBOUNP5 ;ALB/CJM - INPATIENT INSURANCE REPORT ;JAN 25,1992
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ; TIME appointment or admission time time
+3 ; CTG category vet is in (no,expired,unknow)
+4 ; INS =1 in there is insurance data
+5 ; RPTD =1 if appt should appear on report
+6 ; IBOPICK ="D" if the user chose to enter a date range, otherwise ="C"
+7 ; for the current date
+8 ; END2 30 days into the future, starting either from the curren date
+9 ; or END, depending on IBOPICK
LOOP ; loops through inpatients
+1 NEW DIV,DFN,PAT,TIME,CTG,INS,QUIT,RPTD,END2
+2 IF IBOPICK="C"
DO LOOP1
+3 IF IBOPICK="D"
DO LOOP2
+4 QUIT
LOOP1 ; finds current admissions for selected divisions
+1 NEW TDY,WRD,WRDN,ADM,DTH,R
SET WRD=0
+2 DO NOW^%DTC
SET (TDY,X1)=X
SET X2=30
DO C^%DTC
SET END2=X
+3 FOR
SET WRD=$ORDER(^DIC(42,WRD))
if WRD'>0
QUIT
SET R=$GET(^(WRD,0))
SET DIV=$PIECE(R,"^",11)
SET WRDN=$PIECE(R,"^",1)
DO DIV
IF 'QUIT&(WRDN]"")
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WRDN,DFN))
if DFN'>0
QUIT
SET ADM=^(DFN)
IF ADM]""
IF $PIECE($GET(^DGPM(+ADM,0)),"^",2)=1
SET TIME=+^(0)
SET DTH=+$GET(^DPT(DFN,.35))
if 'DTH!((DTH\1)=TDY)
DO PROC
End DoDot:1
+5 QUIT
LOOP2 ; finds admissions during selected date range for selected divisions
+1 NEW WRD0,WRDN
+2 NEW T
SET X1=IBOEND
SET X2=30
DO C^%DTC
SET END2=X
+3 SET T=(IBOBEG-.0001)
+4 FOR
SET T=$ORDER(^DGPM("AMV1",T))
if 'T!(T>(IBOEND+.99))
QUIT
Begin DoDot:1
+5 SET DFN=0
FOR
SET DFN=$ORDER(^DGPM("AMV1",T,DFN))
if 'DFN
QUIT
SET DIV=""
SET DIV=$ORDER(^DGPM("AMV1",T,DFN,DIV))
if DIV'>0
QUIT
SET WRD0=$GET(^DIC(42,+$PIECE($GET(^DGPM(DIV,0)),U,6),0))
SET DIV=+$PIECE(WRD0,U,11)
SET WRDN=$PIECE(WRD0,"^")
SET TIME=T
SET QUIT=0
if DIV
DO PROC
End DoDot:1
+6 QUIT
PROC ;
+1 if IBOPICK'="C"
DO DIV
if 'QUIT
DO DONE
if 'QUIT
DO VET
SET RPTD=0
if 'QUIT
if IBOUK
DO UNK
if 'RPTD&IBOEXP
DO EXP
if 'RPTD&IBOUI
DO UNI
if RPTD
DO INDEX
+2 QUIT
VET ; checks if patient is a vet
+1 SET QUIT=1
DO ELIG^VADPT
if VAERR
QUIT
if VAEL(4)
SET QUIT=0
+2 QUIT
DONE ; checks if patient already on report
+1 if $DATA(^TMP($JOB,"PATIENTS",DFN))
SET QUIT=1
+2 QUIT
INDEX ; indexes appointment,also indexs vet so he won't be reported twice
+1 NEW NAME,D
+2 SET D=""
+3 IF DIV
SET D=$PIECE($GET(^DG(40.8,DIV,0)),"^",1)
+4 IF D=""
SET D="NOT KNOWN"
+5 IF WRDN=""
SET WRDN="NOT KNOWN"
+6 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^",1)
if NAME'[""
QUIT
+7 SET ^TMP($JOB,CTG,D,$SELECT(IBOBYWRD:WRDN,1:"ALL WARDS"),NAME,DFN)=TIME_"^"_WRDN
+8 SET ^TMP($JOB,"PATIENTS",DFN)=""
+9 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 RPTD=0
NEW T
SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)
IF T="U"!(T="")
DO CKINS
IF 'INS
SET CTG="UNKNOWN"
SET RPTD=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 RPTD=0
NEW T,E
DO CKINS
IF 'INS
QUIT
+3 SET RPTD=1
SET CTG="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>END2)
SET RPTD=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 RPTD=0
NEW T
SET T=$PIECE($GET(^DPT(DFN,.31)),"^",11)
IF T="N"!(T="Y")
DO CKINS
IF 'INS
SET CTG="NO"
SET RPTD=1
+3 QUIT
CKINS ; checks if any insurance in insurance multiple of patient record
+1 SET INS=0
IF $ORDER(^DPT(DFN,.312,0))
SET INS=1
+2 QUIT
DIV ; checks if the division is on the list VAUTD()
+1 SET QUIT=0
IF VAUTD=1
QUIT
+2 IF 'DIV
SET QUIT=1
QUIT
+3 IF '$DATA(VAUTD(+DIV))
SET QUIT=1
+4 QUIT
