IBOSTUS1 ;ALB/SGD - MCCR BILL STATUS REPORT ;25 MAY 88 14:19
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCROST1
;
BEGIN N IBSUB,IBHDR,IBST1,IBST2,IBCAT,IBAMT,IBHDR3,IBBEF,IBCRT,IBQUIT,IBMTCT S IBBEF="",IBQUIT=0
S IBCRT=$S($E($G(IOST),1,2)="C-":1,1:0)
S:IBDTP="Entered" IBSUB="APD",IBHDR=1
S:IBDTP="Bill" IBSUB="AP",IBHDR=1
S:IBDTP="Event" IBSUB="D",IBHDR=0
S Y=IBBEG X ^DD("DD") S IBHD="Medical Care Cost Recovery Bill Status Report for "_$S(IBBEG'=IBEND:"period covering ",1:"")_Y I IBBEG<IBEND S Y=IBEND X ^DD("DD") S IBHD=IBHD_" through "_Y
S IBPAGE=0,(IBL,IBL1)="",$P(IBL,"=",131)="",$P(IBL1,"-",131)="",X1=IBBEG\1,X2=-1 D C^%DTC S IBNEX=X_.2359,X=132 X ^%ZOSF("RM")
D HEAD F S IBNEX=$O(^DGCR(399,IBSUB,IBNEX)) Q:'IBNEX!(IBNEX>(IBEND\1_.2359))!(IBQUIT) D:$Y>$S($D(IOSL):(IOSL-$S(IBCRT:4,1:9)),1:20) NOTE,HEAD Q:IBQUIT D
.D:IBHDR SUBHDR S IBIFN="" F J=0:0 S IBIFN=$O(^DGCR(399,IBSUB,IBNEX,IBIFN)) Q:'IBIFN!IBQUIT D SET S IBBEF=IBNEX
I 'IBQUIT D
.D:$D(IBF) NOTE
.I '$D(IBF) W !!,?30,"No matches found"
.E D STATS^IBOSTUS
Q I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K %,I,J,X,X1,X2,Y,Z,IBIFN,%DT,IBAPP,POP,IBPAGE,DGPGM,DGVAR,IBNEX,IBF,IBBEG,IBEND,IBHD,IBHD2,IBL,IBL1,IBBST,IBBS,IBBSBY,IBBSDT,IB0,IBS,IBU1,DFN,VAERR,IBDTP,IBBY
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS1" D T1^%ZOSV ;stop rt clock
Q
SET S IBS=^DGCR(399,IBIFN,"S"),IBAPP=1
I $P(IBS,"^",17)'="" S IBBS=" CANCELLED",IBBSDT=$P(IBS,"^",17),IBBSBY=$P(IBS,"^",18) D:IBBST="C" PRINT G ALL
I $P(IBS,"^",14)'="" S IBBS=" PRINTED",IBBSDT=$P(IBS,"^",14),IBBSBY=$P(IBS,"^",15) D:IBBST="P" PRINT G ALL
I $P(IBS,"^",10)'="" S IBBS="* AUTHORIZED",IBAPP=$P(IBS,"^",9),IBBSDT=$P(IBS,"^",10),IBBSBY=$P(IBS,"^",11) D:IBBST="A" PRINT G ALL
I $P(IBS,"^",7)'="" S IBBS="* REVIEWED",IBAPP=$P(IBS,"^",6),IBBSDT=$P(IBS,"^",7),IBBSBY=$P(IBS,"^",8) D:IBBST="R" PRINT G ALL
I $P(IBS,"^",4)'="" S IBBS="* REVIEWED",IBAPP=$P(IBS,"^",3),IBBSDT=$P(IBS,"^",4),IBBSBY=$P(IBS,"^",5) D:IBBST="R" PRINT G ALL
S IBBS="* ENTERED",IBBSDT=$P(IBS,"^",1),IBBSBY=$P(IBS,"^",2) D:IBBST="E" PRINT
ALL Q:IBQUIT
D:IBBST="ALL" PRINT
Q
PRINT I $Y>$S($D(IOSL):(IOSL-$S(IBCRT:4,1:6)),1:6) D NOTE D HEAD Q:IBQUIT D SUBHDR:(IBBEF=IBNEX)&IBHDR
S IBF=1,IB0=^DGCR(399,IBIFN,0),DFN=$P(IB0,"^",2) D PID^VADPT6 W !,$P(IB0,"^",1),?10,$E($P(^DPT($P(IB0,"^",2),0),"^",1),1,20),?31,VA("BID"),?39,$E($P(IB0,"^",3),4,5),"/",$E($P(IB0,"^",3),6,7),"/",$E($P(IB0,"^",3),2,3)
S IBBY=$P(IBS,"^",2) I IBBY W ?50,$E($S($D(^VA(200,IBBY,0)):$P(^(0),"^",2),1:"UNKN"),1,4)
S IBCAT=$S($D(^DGCR(399.3,+$P(IB0,"^",7),0)):$P(^(0),"^",4),1:"UNSPECIFIED")_$S($P(IB0,"^",5)>2:"-OPT",1:"-INPT") W ?57,IBCAT
; MT category as of event date
S IBMTCT=$P($$LST^DGMTU(DFN,$P(IB0,"^",3)),"^",4) S:IBMTCT="" IBMTCT="N/A" W ?72,IBMTCT
;
S IBU1=$S($D(^DGCR(399,IBIFN,"U1")):^DGCR(399,IBIFN,"U1"),1:""),(IBAMT,X)=$S(IBU1="":0,$P(IBU1,"^",2)]"":$P(IBU1,"^",1)-$P(IBU1,"^",2),1:$P(IBU1,"^",1)),X2="2$" D COMMA^%DTC W ?77,$J(X,10)
W ?90,IBBS,$S('IBAPP:"/DISAPP",1:"")," ",$E(IBBSDT,4,5),"/",$E(IBBSDT,6,7),"/",$E(IBBSDT,2,3)," (",$S($D(^VA(200,+IBBSBY,0)):$P(^(0),"^",2),1:"UNKN USER"),"/",IBBSBY,")" K VA("BID"),VA("PID")
D ADD
Q
HEAD I $G(IBPAGE)>0,IBCRT S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1 Q
S IBPAGE=IBPAGE+1 W:$E(IOST,1,2)["C-"!(IBPAGE>1) !,@IOF,!
I 'IBCRT D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W ?94,"Date/Time Printed: ",Y,!!,IBHD,?121,"PAGE ",IBPAGE,!,IBL1,!!
W:$D(IBHD2) ?40,"BILL STATUS: ",IBHD2,!
W:'$D(IBHDR3) ?39,"EVENT",?49,"ENTRD",?73,"MT",!,"BILL NO.",?10,"PATIENT NAME",?31,"PT.ID",?39,"DATE",?50,"BY",?57,"RATE TYPE",?70,"CATEGORY",?81,"CHARGES",?94,"BILL STATUS",!,IBL
W:$D(IBHDR3) ?54,IBHDR3,!,IBL
Q
NOTE ;
I IBBST'="C"!(IBBST'="P") W !!,"* Denotes that the bill status is not Printed or Cancelled"
Q
SUBHDR ;
W !!," "_IBDTP_" Date: "_$$DAT1^IBOUTL(IBNEX),!
Q
ADD ; for statistics
S IBST1(IBCAT,"C")=1+$G(IBST1(IBCAT,"C"))
S IBST1(IBCAT,"$")=IBAMT+$G(IBST1(IBCAT,"$"))
S:IBBS["* " IBBS=$P(IBBS,"* ",2)
S:IBBS[" " IBBS=$P(IBBS," ",2)
S:IBBS="" IBBS="UNKNOWN"
S IBST2(IBBS,"C")=1+$G(IBST2(IBBS,"C"))
S IBST2(IBBS,"$")=IBAMT+$G(IBST2(IBBS,"$"))
Q
IBOSTUS1 ;ALB/SGD - MCCR BILL STATUS REPORT ;25 MAY 88 14:19
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCROST1
+4 ;
BEGIN NEW IBSUB,IBHDR,IBST1,IBST2,IBCAT,IBAMT,IBHDR3,IBBEF,IBCRT,IBQUIT,IBMTCT
SET IBBEF=""
SET IBQUIT=0
+1 SET IBCRT=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+2 IF IBDTP="Entered"
SET IBSUB="APD"
SET IBHDR=1
+3 IF IBDTP="Bill"
SET IBSUB="AP"
SET IBHDR=1
+4 IF IBDTP="Event"
SET IBSUB="D"
SET IBHDR=0
+5 SET Y=IBBEG
XECUTE ^DD("DD")
SET IBHD="Medical Care Cost Recovery Bill Status Report for "_$SELECT(IBBEG'=IBEND:"period covering ",1:"")_Y
IF IBBEG<IBEND
SET Y=IBEND
XECUTE ^DD("DD")
SET IBHD=IBHD_" through "_Y
+6 SET IBPAGE=0
SET (IBL,IBL1)=""
SET $PIECE(IBL,"=",131)=""
SET $PIECE(IBL1,"-",131)=""
SET X1=IBBEG\1
SET X2=-1
DO C^%DTC
SET IBNEX=X_.2359
SET X=132
XECUTE ^%ZOSF("RM")
+7 DO HEAD
FOR
SET IBNEX=$ORDER(^DGCR(399,IBSUB,IBNEX))
IF 'IBNEX!(IBNEX>(IBEND\1_.2359))!(IBQUIT)
QUIT
IF $Y>$SELECT($DATA(IOSL)
DO NOTE
DO HEAD
IF IBQUIT
QUIT
Begin DoDot:1
+8 IF IBHDR
DO SUBHDR
SET IBIFN=""
FOR J=0:0
SET IBIFN=$ORDER(^DGCR(399,IBSUB,IBNEX,IBIFN))
IF 'IBIFN!IBQUIT
QUIT
DO SET
SET IBBEF=IBNEX
End DoDot:1
+9 IF 'IBQUIT
Begin DoDot:1
+10 IF $DATA(IBF)
DO NOTE
+11 IF '$DATA(IBF)
WRITE !!,?30,"No matches found"
+12 IF '$TEST
DO STATS^IBOSTUS
End DoDot:1
Q IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+1 DO ^%ZISC
+2 KILL %,I,J,X,X1,X2,Y,Z,IBIFN,%DT,IBAPP,POP,IBPAGE,DGPGM,DGVAR,IBNEX,IBF,IBBEG,IBEND,IBHD,IBHD2,IBL,IBL1,IBBST,IBBS,IBBSBY,IBBSDT,IB0,IBS,IBU1,DFN,VAERR,IBDTP,IBBY
+3 ;***
+4 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOSTUS1" D T1^%ZOSV ;stop rt clock
+5 QUIT
SET SET IBS=^DGCR(399,IBIFN,"S")
SET IBAPP=1
+1 IF $PIECE(IBS,"^",17)'=""
SET IBBS=" CANCELLED"
SET IBBSDT=$PIECE(IBS,"^",17)
SET IBBSBY=$PIECE(IBS,"^",18)
IF IBBST="C"
DO PRINT
GOTO ALL
+2 IF $PIECE(IBS,"^",14)'=""
SET IBBS=" PRINTED"
SET IBBSDT=$PIECE(IBS,"^",14)
SET IBBSBY=$PIECE(IBS,"^",15)
IF IBBST="P"
DO PRINT
GOTO ALL
+3 IF $PIECE(IBS,"^",10)'=""
SET IBBS="* AUTHORIZED"
SET IBAPP=$PIECE(IBS,"^",9)
SET IBBSDT=$PIECE(IBS,"^",10)
SET IBBSBY=$PIECE(IBS,"^",11)
IF IBBST="A"
DO PRINT
GOTO ALL
+4 IF $PIECE(IBS,"^",7)'=""
SET IBBS="* REVIEWED"
SET IBAPP=$PIECE(IBS,"^",6)
SET IBBSDT=$PIECE(IBS,"^",7)
SET IBBSBY=$PIECE(IBS,"^",8)
IF IBBST="R"
DO PRINT
GOTO ALL
+5 IF $PIECE(IBS,"^",4)'=""
SET IBBS="* REVIEWED"
SET IBAPP=$PIECE(IBS,"^",3)
SET IBBSDT=$PIECE(IBS,"^",4)
SET IBBSBY=$PIECE(IBS,"^",5)
IF IBBST="R"
DO PRINT
GOTO ALL
+6 SET IBBS="* ENTERED"
SET IBBSDT=$PIECE(IBS,"^",1)
SET IBBSBY=$PIECE(IBS,"^",2)
IF IBBST="E"
DO PRINT
ALL IF IBQUIT
QUIT
+1 IF IBBST="ALL"
DO PRINT
+2 QUIT
PRINT IF $Y>$SELECT($DATA(IOSL):(IOSL-$SELECT(IBCRT:4,1:6)),1:6)
DO NOTE
DO HEAD
IF IBQUIT
QUIT
IF (IBBEF=IBNEX)&IBHDR
DO SUBHDR
+1 SET IBF=1
SET IB0=^DGCR(399,IBIFN,0)
SET DFN=$PIECE(IB0,"^",2)
DO PID^VADPT6
WRITE !,$PIECE(IB0,"^",1),?10,$EXTRACT($PIECE(^DPT($PIECE(IB0,"^",2),0),"^",1),1,20),?31,VA("BID"),?39,$EXTRACT($PIECE(IB0,"^",3),4,5),"/",$EXTRACT($PIECE(IB0,"^",3),6,7),"/",$EXTRACT($PIECE(IB0,"^",3),2,3)
+2 SET IBBY=$PIECE(IBS,"^",2)
IF IBBY
WRITE ?50,$EXTRACT($SELECT($DATA(^VA(200,IBBY,0)):$PIECE(^(0),"^",2),1:"UNKN"),1,4)
+3 SET IBCAT=$SELECT($DATA(^DGCR(399.3,+$PIECE(IB0,"^",7),0)):$PIECE(^(0),"^",4),1:"UNSPECIFIED")_$SELECT($PIECE(IB0,"^",5)>2:"-OPT",1:"-INPT")
WRITE ?57,IBCAT
+4 ; MT category as of event date
+5 SET IBMTCT=$PIECE($$LST^DGMTU(DFN,$PIECE(IB0,"^",3)),"^",4)
IF IBMTCT=""
SET IBMTCT="N/A"
WRITE ?72,IBMTCT
+6 ;
+7 SET IBU1=$SELECT($DATA(^DGCR(399,IBIFN,"U1")):^DGCR(399,IBIFN,"U1"),1:"")
SET (IBAMT,X)=$SELECT(IBU1="":0,$PIECE(IBU1,"^",2)]"":$PIECE(IBU1,"^",1)-$PIECE(IBU1,"^",2),1:$PIECE(IBU1,"^",1))
SET X2="2$"
DO COMMA^%DTC
WRITE ?77,$JUSTIFY(X,10)
+8 WRITE ?90,IBBS,$SELECT('IBAPP:"/DISAPP",1:"")," ",$EXTRACT(IBBSDT,4,5),"/",$EXTRACT(IBBSDT,6,7),"/",$EXTRACT(IBBSDT,2,3)," (",$SELECT($DATA(^VA(200,+IBBSBY,0)):$PIECE(^(0),"^",2),1:"UNKN USER"),"/",IBBSBY,")"
KILL VA("BID"),VA("PID")
+9 DO ADD
+10 QUIT
HEAD IF $GET(IBPAGE)>0
IF IBCRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET IBQUIT=1
QUIT
+1 SET IBPAGE=IBPAGE+1
IF $EXTRACT(IOST,1,2)["C-"!(IBPAGE>1)
WRITE !,@IOF,!
+2 IF 'IBCRT
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
WRITE ?94,"Date/Time Printed: ",Y,!!,IBHD,?121,"PAGE ",IBPAGE,!,IBL1,!!
+3 IF $DATA(IBHD2)
WRITE ?40,"BILL STATUS: ",IBHD2,!
+4 IF '$DATA(IBHDR3)
WRITE ?39,"EVENT",?49,"ENTRD",?73,"MT",!,"BILL NO.",?10,"PATIENT NAME",?31,"PT.ID",?39,"DATE",?50,"BY",?57,"RATE TYPE",?70,"CATEGORY",?81,"CHARGES",?94,"BILL STATUS",!,IBL
+5 IF $DATA(IBHDR3)
WRITE ?54,IBHDR3,!,IBL
+6 QUIT
NOTE ;
+1 IF IBBST'="C"!(IBBST'="P")
WRITE !!,"* Denotes that the bill status is not Printed or Cancelled"
+2 QUIT
SUBHDR ;
+1 WRITE !!," "_IBDTP_" Date: "_$$DAT1^IBOUTL(IBNEX),!
+2 QUIT
ADD ; for statistics
+1 SET IBST1(IBCAT,"C")=1+$GET(IBST1(IBCAT,"C"))
+2 SET IBST1(IBCAT,"$")=IBAMT+$GET(IBST1(IBCAT,"$"))
+3 IF IBBS["* "
SET IBBS=$PIECE(IBBS,"* ",2)
+4 IF IBBS[" "
SET IBBS=$PIECE(IBBS," ",2)
+5 IF IBBS=""
SET IBBS="UNKNOWN"
+6 SET IBST2(IBBS,"C")=1+$GET(IBST2(IBBS,"C"))
+7 SET IBST2(IBBS,"$")=IBAMT+$GET(IBST2(IBBS,"$"))
+8 QUIT
