- IBOHLD2 ;ALB/CJM - REPORT OR HELD CATC CHARGES ;MAR 6,1991
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- REPORT ;
- N IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBN
- S IBCRT=0,IBBOT=6,IBQUIT=0 I $E(IOST,1,2)="C-" S IBCRT=1,IBBOT=2
- S IBLINE="",$P(IBLINE,"=",86)="||",IBLINE=IBLINE_$E(IBLINE,1,45)
- D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y
- I IBCRT W @IOF
- LOOP ;
- S IBPAGE=1 D HEADER Q:IBQUIT
- S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME=""!(IBQUIT) S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN!(IBQUIT) D PRNTPAT Q:IBQUIT S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN!(IBQUIT) D
- .D PRNTCHG,PRNTBILL:'IBQUIT
- Q
- PRNTBILL ; prints bills for a charge
- N IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
- D:$Y-IBBOT+1>IOSL HEADER Q:IBQUIT
- S IB="" F I=1:1 S IB=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IB)) W:'IB&(I<2) ?85,"||",! D:$Y+IBBOT>IOSL HEADER Q:'IB!(IBQUIT) D
- .W ?85,"||"
- .S IB0=$G(^DGCR(399,IB,0)) Q:IB0=""
- .W ?88,$P(IB0,"^",1) ; bill #
- .S IBSTAT=$$STA^PRCAFN(IB)
- .W:+IBSTAT>0 ?97,$E($P(IBSTAT,"^",2),1,14)
- .S IBT=$J((+^DGCR(399,IB,"U1")-$P(^("U1"),"^",2)),9,2)
- .W ?112,IBT ; total charges
- .S IBPD=$$TPR^PRCAFN(IB) S:IBPD<0 IBPD="" S IBPD=$J(IBPD,9,2) W ?123,IBPD,! D:$Y+IBBOT>IOSL HEADER
- Q
- PRNTPAT ; prints patient data
- N VAERR,VADM,IBSSN D DEM^VADPT S:'VAERR IBSSN=VA("BID") ; pt id,brief
- D:$Y+IBBOT>IOSL HEADER Q:IBQUIT
- W $E(IBNAME,1,20),?22,IBSSN
- Q
- PRNTCHG ; prints a charge
- N IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND
- S IBND=$G(^IB(IBN,0))
- ; action id
- S IBACT=+IBND
- ; type
- S IBTYPE=$P(IBND,"^",3),IBTYPE=$E($P($G(^IBE(350.1,IBTYPE,0)),"^",1),4,7)
- ; bill #
- S IBBILL=$P($P(IBND,"^",11),"-",2)
- ; from date
- S IBFR=$$DAT1^IBOUTL($P(IBND,"^",14))
- ; to date
- S IBTO=$$DAT1^IBOUTL($P(IBND,"^",15))
- ; charge$
- S IBCHG=$J(+$P(IBND,"^",7),9,2)
- W ?29,IBACT,?39,IBTYPE,?46,IBBILL,?55,IBFR,?66,IBTO,?75,IBCHG
- Q
- Q:IBQUIT
- I IBCRT,$Y>1 D Q:IBQUIT
- .F Q:$Y>(IOSL-1) W !
- .N T R " Press RETURN to continue",T:DTIME I '$T!(T["^") S IBQUIT=1 Q
- I IBPAGE>1 W !,@IOF
- W ?53,"CATEGORY C CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
- W !,"Name",?22,"Pt.ID",?29,"ActionID",?39,"Type",?46,"Bill#",?55,"From",?66,"To",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
- W !,IBLINE,!
- S IBPAGE=IBPAGE+1
- Q
- IBOHLD2 ;ALB/CJM - REPORT OR HELD CATC CHARGES ;MAR 6,1991
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- REPORT ;
- +1 NEW IBQUIT,IBPAGE,IBNOW,IBLINE,IBCRT,IBBOT,DFN,IBNAME,IBN
- +2 SET IBCRT=0
- SET IBBOT=6
- SET IBQUIT=0
- IF $EXTRACT(IOST,1,2)="C-"
- SET IBCRT=1
- SET IBBOT=2
- +3 SET IBLINE=""
- SET $PIECE(IBLINE,"=",86)="||"
- SET IBLINE=IBLINE_$EXTRACT(IBLINE,1,45)
- +4 DO NOW^%DTC
- SET Y=X
- XECUTE ^DD("DD")
- SET IBNOW=Y
- +5 IF IBCRT
- WRITE @IOF
- LOOP ;
- +1 SET IBPAGE=1
- DO HEADER
- IF IBQUIT
- QUIT
- +2 SET IBNAME=""
- FOR
- SET IBNAME=$ORDER(^TMP($JOB,"HOLD",IBNAME))
- IF IBNAME=""!(IBQUIT)
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
- IF 'DFN!(IBQUIT)
- QUIT
- DO PRNTPAT
- IF IBQUIT
- QUIT
- SET IBN=0
- FOR
- SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN))
- IF 'IBN!(IBQUIT)
- QUIT
- Begin DoDot:1
- +3 DO PRNTCHG
- IF 'IBQUIT
- DO PRNTBILL
- End DoDot:1
- +4 QUIT
- PRNTBILL ; prints bills for a charge
- +1 NEW IB,IB0,IBSTAT,IBCHG,IBPD,C,Y,I,IBT
- +2 IF $Y-IBBOT+1>IOSL
- DO HEADER
- IF IBQUIT
- QUIT
- +3 SET IB=""
- FOR I=1:1
- SET IB=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IB))
- IF 'IB&(I<2)
- WRITE ?85,"||",!
- IF $Y+IBBOT>IOSL
- DO HEADER
- IF 'IB!(IBQUIT)
- QUIT
- Begin DoDot:1
- +4 WRITE ?85,"||"
- +5 SET IB0=$GET(^DGCR(399,IB,0))
- IF IB0=""
- QUIT
- +6 ; bill #
- WRITE ?88,$PIECE(IB0,"^",1)
- +7 SET IBSTAT=$$STA^PRCAFN(IB)
- +8 IF +IBSTAT>0
- WRITE ?97,$EXTRACT($PIECE(IBSTAT,"^",2),1,14)
- +9 SET IBT=$JUSTIFY((+^DGCR(399,IB,"U1")-$PIECE(^("U1"),"^",2)),9,2)
- +10 ; total charges
- WRITE ?112,IBT
- +11 SET IBPD=$$TPR^PRCAFN(IB)
- IF IBPD<0
- SET IBPD=""
- SET IBPD=$JUSTIFY(IBPD,9,2)
- WRITE ?123,IBPD,!
- IF $Y+IBBOT>IOSL
- DO HEADER
- End DoDot:1
- +12 QUIT
- PRNTPAT ; prints patient data
- +1 ; pt id,brief
- NEW VAERR,VADM,IBSSN
- DO DEM^VADPT
- IF 'VAERR
- SET IBSSN=VA("BID")
- +2 IF $Y+IBBOT>IOSL
- DO HEADER
- IF IBQUIT
- QUIT
- +3 WRITE $EXTRACT(IBNAME,1,20),?22,IBSSN
- +4 QUIT
- PRNTCHG ; prints a charge
- +1 NEW IBACT,IBTYPE,IBBILL,IBFR,IBTO,IBCHG,IBND
- +2 SET IBND=$GET(^IB(IBN,0))
- +3 ; action id
- +4 SET IBACT=+IBND
- +5 ; type
- +6 SET IBTYPE=$PIECE(IBND,"^",3)
- SET IBTYPE=$EXTRACT($PIECE($GET(^IBE(350.1,IBTYPE,0)),"^",1),4,7)
- +7 ; bill #
- +8 SET IBBILL=$PIECE($PIECE(IBND,"^",11),"-",2)
- +9 ; from date
- +10 SET IBFR=$$DAT1^IBOUTL($PIECE(IBND,"^",14))
- +11 ; to date
- +12 SET IBTO=$$DAT1^IBOUTL($PIECE(IBND,"^",15))
- +13 ; charge$
- +14 SET IBCHG=$JUSTIFY(+$PIECE(IBND,"^",7),9,2)
- +15 WRITE ?29,IBACT,?39,IBTYPE,?46,IBBILL,?55,IBFR,?66,IBTO,?75,IBCHG
- +16 QUIT
- +1 IF IBQUIT
- QUIT
- +2 IF IBCRT
- IF $Y>1
- Begin DoDot:1
- +3 FOR
- IF $Y>(IOSL-1)
- QUIT
- WRITE !
- +4 NEW T
- READ " Press RETURN to continue",T:DTIME
- IF '$TEST!(T["^")
- SET IBQUIT=1
- QUIT
- End DoDot:1
- IF IBQUIT
- QUIT
- +5 IF IBPAGE>1
- WRITE !,@IOF
- +6 WRITE ?53,"CATEGORY C CHARGES ON HOLD",?110,IBNOW," PAGE ",IBPAGE,!,"HELD CHARGES",?87,"CORRESPONDING THIRD PARTY BILLS",!,IBLINE
- +7 WRITE !,"Name",?22,"Pt.ID",?29,"ActionID",?39,"Type",?46,"Bill#",?55,"From",?66,"To",?78,"Charge",?85,"||",?88,"Bill#",?97,"AR-Status",?115,"Charge",?128,"Paid"
- +8 WRITE !,IBLINE,!
- +9 SET IBPAGE=IBPAGE+1
- +10 QUIT
