IBOMTP1 ;ALB/CPM - CATEGORY C BILLING PROFILE (CON'T) ; 10-DEC-91
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;***
;S XRTL=$ZU(0),XRTN="IBOMTP1-2" D T0^%ZOSV ;start rt clock
; Begin compilation. Start with billing clocks.
S Y=-(IBEDT+.1),X=0 F Q:-Y<IBBDT S Y=$O(^IBE(351,"AIVDT",IBDFN,Y)) Q:'Y F S X=$O(^IBE(351,"AIVDT",IBDFN,Y,X)) Q:'X S:$P($G(^IBE(351,X,0)),"^",4)'=3 ^TMP($J,"IBOMTP",-Y,"C")=""
;
; Get O/P visits from file #399.
S X1=IBBDT,X2=-1 D C^%DTC S Y=X
F S Y=$O(^DGCR(399,"AOPV",IBDFN,Y)) Q:'Y!(Y>IBEDT) D
. S IBDA=0 F S IBDA=$O(^DGCR(399,"AOPV",IBDFN,Y,IBDA)) Q:'IBDA D
.. I $D(^DGCR(399,+IBDA,0)),'$P($G(^("S")),"^",16),$P($G(^DGCR(399.3,+$P(^(0),"^",7),0)),"^")["MEANS" S ^TMP($J,"IBOMTP",Y,"M"_IBDA)=""
;
; Get the rest of the charges from file #350.
S Y="" F S Y=$O(^IB("AFDT",IBDFN,Y)) Q:'Y I -Y'>IBEDT S Y1=0 F S Y1=$O(^IB("AFDT",IBDFN,Y,Y1)) Q:'Y1 D
. S IBDA=0 F S IBDA=$O(^IB("AF",Y1,IBDA)) Q:'IBDA D
.. Q:'$D(^IB(IBDA,0)) S IBX=^(0)
.. Q:$P(IBX,"^",8)["ADMISSION"
.. I $P(IBX,"^",15)<IBBDT!($P(IBX,"^",14)>IBEDT) Q
.. S ^TMP($J,"IBOMTP",+$P(IBX,"^",14),"I"_IBDA)=""
;
; Print report.
D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
S IBLINE="",$P(IBLINE,"-",IOM+1)="",(IBPAG,IBCHGT,IBQUIT)=0
S IBPT=$$PT^IBEFUNC(IBDFN)
S IBH="Category C Billing Profile for "_$P(IBPT,"^")_" "_$P(IBPT,"^",2) D HDR
I '$D(^TMP($J,"IBOMTP")) W !,"This patient has no Category C bills." D PAUSE^IBOUTL G END
; - first, print detail lines
S IBD="" F S IBD=$O(^TMP($J,"IBOMTP",IBD)) Q:'IBD D G:IBQUIT END
. S IBTY="" F S IBTY=$O(^TMP($J,"IBOMTP",IBD,IBTY)) Q:IBTY="" D Q:IBQUIT
.. I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
.. W !,$$DAT1^IBOUTL(IBD)
.. I IBTY="C" W ?12,"Begin Category C Billing Clock" Q
.. S IBDA=+$E(IBTY,2,99),IBD0=$S($E(IBTY)="M":$G(^DGCR(399,IBDA,0)),1:$G(^IB(IBDA,0))),IBSEQ=0
.. I $E(IBTY)="I" S IBSEQ=$P($G(^IBE(350.1,+$P(IBD0,"^",3),0)),"^",5)
.. W ?14,$S($E(IBTY)="M":"OPT COPAYMENT (UB-82)",1:$$ACTNM^IBOUTL(+$P(IBD0,"^",3)))
.. W ?44,$S($E(IBTY)="M":$P(IBD0,"^"),1:$$STAT())
.. I $E(IBTY)="I",$P(IBD0,"^",14)'=$P(IBD0,"^",15) W ?54,$$DAT1^IBOUTL($P(IBD0,"^",15))
.. I $E(IBTY)="M" S X=+$O(^DGCR(399,IBDA,"RC","B",500,0)),IBCHG=+$P($G(^DGCR(399,IBDA,"RC",X,0)),"^",2)
.. E S IBCHG=+$P(IBD0,"^",7)
.. I IBSEQ=2 S IBCHG=-IBCHG
.. I $E(IBTY)="I",$P(IBD0,"^",11)="",$P($G(^IBE(350.21,+$P(IBD0,"^",5),0)),"^",5) S IBCHG=0
.. S X=IBCHG,X2="2$",X3=10 D COMMA^%DTC W ?65,X
.. S IBCHGT=IBCHGT+IBCHG
.. I IBSEQ=2!($P(IBD0,"^",11)=""&($P($G(^IBE(350.21,+$P(IBD0,"^",5),0)),"^",5))) W !?5,"Charge Removal Reason: ",$S($D(^IBE(350.3,+$P(IBD0,"^",10),0)):$P(^(0),"^"),1:"UNKNOWN")
; - print totals line
I $Y>(IOSL-5) D PAUSE^IBOUTL G:IBQUIT END D HDR
W !?63,"-----------" S X=IBCHGT,X2="2$",X3=12 D COMMA^%DTC W !?63,X
D PAUSE^IBOUTL
; - close device and quit
END K ^TMP($J)
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP1" D T1^%ZOSV ;stop rt clock
I $D(ZTQUEUED) S ZTREQ="@" Q
K IBJ,IBD,IBH,IBHDT,IBTY,IBDA,IBD0,IBSEQ,IBQUIT,IBCHG,IBCHGT,IBPAG,IBLINE,IBX,IBPT,X,X2,X3,Y,Y1
D ^%ZISC Q
;
;
HDR ; Print header.
I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
S IBPAG=IBPAG+1 W ?(80-$L(IBH)\2),IBH
W !,"From ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT)
W ?IOM-36,IBHDT,?IOM-9,"Page: ",IBPAG
W !,"BILL DATE BILL TYPE",?44,"BILL # BILL TO TOT CHARGE"
W !,IBLINE,! Q
;
STAT() ; Display bill number or status
N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBD0,"^",5),0))
Q $S($P(IBSTAT,"^",6):$$HLD(+$P(IBD0,"^",5)),$P(IBD0,"^",5)=99:"Converted",$P(IBD0,"^",11)]"":$P($P(IBD0,"^",11),"-",2),$P(IBSTAT,"^",5):"Cancelled",1:"Pending")
;
HLD(STAT) ; Return an 'on hold' status string
Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Clm",STAT=22:"Adj",1:"Ins")
IBOMTP1 ;ALB/CPM - CATEGORY C BILLING PROFILE (CON'T) ; 10-DEC-91
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;***
+4 ;S XRTL=$ZU(0),XRTN="IBOMTP1-2" D T0^%ZOSV ;start rt clock
+5 ; Begin compilation. Start with billing clocks.
+6 SET Y=-(IBEDT+.1)
SET X=0
FOR
IF -Y<IBBDT
QUIT
SET Y=$ORDER(^IBE(351,"AIVDT",IBDFN,Y))
IF 'Y
QUIT
FOR
SET X=$ORDER(^IBE(351,"AIVDT",IBDFN,Y,X))
IF 'X
QUIT
IF $PIECE($GET(^IBE(351,X,0)),"^",4)'=3
SET ^TMP($JOB,"IBOMTP",-Y,"C")=""
+7 ;
+8 ; Get O/P visits from file #399.
+9 SET X1=IBBDT
SET X2=-1
DO C^%DTC
SET Y=X
+10 FOR
SET Y=$ORDER(^DGCR(399,"AOPV",IBDFN,Y))
IF 'Y!(Y>IBEDT)
QUIT
Begin DoDot:1
+11 SET IBDA=0
FOR
SET IBDA=$ORDER(^DGCR(399,"AOPV",IBDFN,Y,IBDA))
IF 'IBDA
QUIT
Begin DoDot:2
+12 IF $DATA(^DGCR(399,+IBDA,0))
IF '$PIECE($GET(^("S")),"^",16)
IF $PIECE($GET(^DGCR(399.3,+$PIECE(^(0),"^",7),0)),"^")["MEANS"
SET ^TMP($JOB,"IBOMTP",Y,"M"_IBDA)=""
End DoDot:2
End DoDot:1
+13 ;
+14 ; Get the rest of the charges from file #350.
+15 SET Y=""
FOR
SET Y=$ORDER(^IB("AFDT",IBDFN,Y))
IF 'Y
QUIT
IF -Y'>IBEDT
SET Y1=0
FOR
SET Y1=$ORDER(^IB("AFDT",IBDFN,Y,Y1))
IF 'Y1
QUIT
Begin DoDot:1
+16 SET IBDA=0
FOR
SET IBDA=$ORDER(^IB("AF",Y1,IBDA))
IF 'IBDA
QUIT
Begin DoDot:2
+17 IF '$DATA(^IB(IBDA,0))
QUIT
SET IBX=^(0)
+18 IF $PIECE(IBX,"^",8)["ADMISSION"
QUIT
+19 IF $PIECE(IBX,"^",15)<IBBDT!($PIECE(IBX,"^",14)>IBEDT)
QUIT
+20 SET ^TMP($JOB,"IBOMTP",+$PIECE(IBX,"^",14),"I"_IBDA)=""
End DoDot:2
End DoDot:1
+21 ;
+22 ; Print report.
+23 DO NOW^%DTC
SET IBHDT=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+24 SET IBLINE=""
SET $PIECE(IBLINE,"-",IOM+1)=""
SET (IBPAG,IBCHGT,IBQUIT)=0
+25 SET IBPT=$$PT^IBEFUNC(IBDFN)
+26 SET IBH="Category C Billing Profile for "_$PIECE(IBPT,"^")_" "_$PIECE(IBPT,"^",2)
DO HDR
+27 IF '$DATA(^TMP($JOB,"IBOMTP"))
WRITE !,"This patient has no Category C bills."
DO PAUSE^IBOUTL
GOTO END
+28 ; - first, print detail lines
+29 SET IBD=""
FOR
SET IBD=$ORDER(^TMP($JOB,"IBOMTP",IBD))
IF 'IBD
QUIT
Begin DoDot:1
+30 SET IBTY=""
FOR
SET IBTY=$ORDER(^TMP($JOB,"IBOMTP",IBD,IBTY))
IF IBTY=""
QUIT
Begin DoDot:2
+31 IF $Y>(IOSL-5)
DO PAUSE^IBOUTL
IF IBQUIT
QUIT
DO HDR
+32 WRITE !,$$DAT1^IBOUTL(IBD)
+33 IF IBTY="C"
WRITE ?12,"Begin Category C Billing Clock"
QUIT
+34 SET IBDA=+$EXTRACT(IBTY,2,99)
SET IBD0=$SELECT($EXTRACT(IBTY)="M":$GET(^DGCR(399,IBDA,0)),1:$GET(^IB(IBDA,0)))
SET IBSEQ=0
+35 IF $EXTRACT(IBTY)="I"
SET IBSEQ=$PIECE($GET(^IBE(350.1,+$PIECE(IBD0,"^",3),0)),"^",5)
+36 WRITE ?14,$SELECT($EXTRACT(IBTY)="M":"OPT COPAYMENT (UB-82)",1:$$ACTNM^IBOUTL(+$PIECE(IBD0,"^",3)))
+37 WRITE ?44,$SELECT($EXTRACT(IBTY)="M":$PIECE(IBD0,"^"),1:$$STAT())
+38 IF $EXTRACT(IBTY)="I"
IF $PIECE(IBD0,"^",14)'=$PIECE(IBD0,"^",15)
WRITE ?54,$$DAT1^IBOUTL($PIECE(IBD0,"^",15))
+39 IF $EXTRACT(IBTY)="M"
SET X=+$ORDER(^DGCR(399,IBDA,"RC","B",500,0))
SET IBCHG=+$PIECE($GET(^DGCR(399,IBDA,"RC",X,0)),"^",2)
+40 IF '$TEST
SET IBCHG=+$PIECE(IBD0,"^",7)
+41 IF IBSEQ=2
SET IBCHG=-IBCHG
+42 IF $EXTRACT(IBTY)="I"
IF $PIECE(IBD0,"^",11)=""
IF $PIECE($GET(^IBE(350.21,+$PIECE(IBD0,"^",5),0)),"^",5)
SET IBCHG=0
+43 SET X=IBCHG
SET X2="2$"
SET X3=10
DO COMMA^%DTC
WRITE ?65,X
+44 SET IBCHGT=IBCHGT+IBCHG
+45 IF IBSEQ=2!($PIECE(IBD0,"^",11)=""&($PIECE($GET(^IBE(350.21,+$PIECE(IBD0,"^",5),0)),"^",5)))
WRITE !?5,"Charge Removal Reason: ",$SELECT($DATA(^IBE(350.3,+$PIECE(IBD0,"^",10),0)):$PIECE(^(0),"^"),1:"UNKNOWN")
End DoDot:2
IF IBQUIT
QUIT
End DoDot:1
IF IBQUIT
GOTO END
+46 ; - print totals line
+47 IF $Y>(IOSL-5)
DO PAUSE^IBOUTL
IF IBQUIT
GOTO END
DO HDR
+48 WRITE !?63,"-----------"
SET X=IBCHGT
SET X2="2$"
SET X3=12
DO COMMA^%DTC
WRITE !?63,X
+49 DO PAUSE^IBOUTL
+50 ; - close device and quit
END KILL ^TMP($JOB)
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP1" D T1^%ZOSV ;stop rt clock
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 KILL IBJ,IBD,IBH,IBHDT,IBTY,IBDA,IBD0,IBSEQ,IBQUIT,IBCHG,IBCHGT,IBPAG,IBLINE,IBX,IBPT,X,X2,X3,Y,Y1
+5 DO ^%ZISC
QUIT
+6 ;
+7 ;
HDR ; Print header.
+1 IF $EXTRACT(IOST,1,2)["C-"!(IBPAG)
WRITE @IOF,*13
+2 SET IBPAG=IBPAG+1
WRITE ?(80-$LENGTH(IBH)\2),IBH
+3 WRITE !,"From ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT)
+4 WRITE ?IOM-36,IBHDT,?IOM-9,"Page: ",IBPAG
+5 WRITE !,"BILL DATE BILL TYPE",?44,"BILL # BILL TO TOT CHARGE"
+6 WRITE !,IBLINE,!
QUIT
+7 ;
STAT() ; Display bill number or status
+1 NEW IBSTAT
SET IBSTAT=$GET(^IBE(350.21,+$PIECE(IBD0,"^",5),0))
+2 QUIT $SELECT($PIECE(IBSTAT,"^",6):$$HLD(+$PIECE(IBD0,"^",5)),$PIECE(IBD0,"^",5)=99:"Converted",$PIECE(IBD0,"^",11)]"":$PIECE($PIECE(IBD0,"^",11),"-",2),$PIECE(IBSTAT,"^",5):"Cancelled",1:"Pending")
+3 ;
HLD(STAT) ; Return an 'on hold' status string
+1 QUIT "Hold "_$SELECT(STAT=20:"Rate",STAT=21:"Clm",STAT=22:"Adj",1:"Ins")
