- IBCRU5 ;ALB/ARH - RATES: UTILITIES (DISPLAYS) ; 16-MAY-1996
- ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- DISPCS(IBCSFN) ; display charge set data
- N IBCS0,IBBR0,IBRVCD,IBX S IBCSFN=+$G(IBCSFN)
- S IBCS0=$G(^IBE(363.1,IBCSFN,0)),IBBR0=$G(^IBE(363.3,+$P(IBCS0,U,2),0)),IBRVCD=$G(^DGCR(399.2,+$P(IBCS0,U,5),0))
- ;
- W !!!,?4,"Charge Set: ",?19,$E($P(IBCS0,U,1),1,30)
- I +$P(IBCS0,U,4) W ?49,"Charge Type: ",?65,$$EXPAND^IBCRU1(363.1,.04,+$P(IBCS0,U,4))
- W !,?4,"Billing Event: ",?19,$E($$EMUTL^IBCRU1($P(IBCS0,U,3),1),1,28)
- W ?49,"Default Rev Cd: ",?65,$P(IBRVCD,U,1)
- W !,?4,"Billing Rate: ",?19,$E($P(IBBR0,U,1),1,28)
- W ?49,"Default Bed: ",?65,$E($$EMUTL^IBCRU1(+$P(IBCS0,U,6),2),1,15)
- I +$P(IBCS0,U,7) S IBX=$$RGEXT^IBCRU4(+$P(IBCS0,U,7)) I IBX'="" W !,?4,"Region: ",?19,$P(IBX,U,1) W:($L($P(IBX,U,2))>40) !,?17 W " (",$P(IBX,U,2),")"
- I +$P(IBCS0,U,5) W !!,?4,"All Charge Items will use Rev Code ",$P(IBRVCD,U,1)," if one is not specified for the Item."
- I '$P(IBCS0,U,5) W !!,?4,"A Default Rev Code is not specified, one will be required for each Item."
- I +$P(IBBR0,U,4) W !,?4,"All items billable to the ",$P(IBBR0,U,2)," Billing Rate must be ",$$EXPAND^IBCRU1(363.3,.04,+$P(IBBR0,U,4)),"s.",!!
- I '$P(IBBR0,U,4) W !,?4,"The ",$P(IBBR0,U,2)," Billing Rate charges are calculated, there are no Charge Items.",!!
- Q
- ;
- DISPCSL(IBCSFN) ; display one line of charge set data
- N IBCS0,IBRVCD I '$G(IBCSFN) Q
- S IBCS0=$G(^IBE(363.1,IBCSFN,0)),IBRVCD=$G(^DGCR(399.2,+$P(IBCS0,U,5),0))
- I IBCS0'="" W !!,?4,"Set: ",$E($P(IBCS0,U,1),1,30),?55,"Default Rev Cd: ",$P(IBRVCD,U,1)
- Q
- ;
- DISPCI(IBCSFN,IBCISI) ; display all Charge Items for a single billable event for a Charge Set
- ; input IBCISI = pointer to the items source file (not the CI FN)
- N XREF,IBEFDT,IBDA,IBCI0
- S IBCSFN=+$G(IBCSFN),IBCISI=+$G(IBCISI),XREF="AIVDTS"_IBCSFN W !
- S IBEFDT=-99999999 F S IBEFDT=$O(^IBA(363.2,XREF,IBCISI,IBEFDT)) Q:'IBEFDT D
- . S IBDA=0 F S IBDA=$O(^IBA(363.2,XREF,IBCISI,IBEFDT,IBDA)) Q:'IBDA D
- .. D DISPCIL(IBDA)
- W !
- Q
- ;
- DISPCIL(IBDA,IBCNT) ; print a single Charge Item line (input: IBDA = CI IFN, IBCNT = reference #)
- N IBCI0,IBRVCD S IBCI0=$G(^IBA(363.2,+$G(IBDA),0)) Q:'IBCI0
- W !,?5,$G(IBCNT)
- W ?10,$$DATE^IBCRU1($P(IBCI0,U,3))
- I +$P(IBCI0,U,4) W ?19,"- ",$$DATE^IBCRU1($P(IBCI0,U,4))
- W ?30,$J($P(IBCI0,U,5),10,2)
- S IBRVCD=$G(^DGCR(399.2,+$P(IBCI0,U,6),0))
- W ?45,$P(IBRVCD,U,1),?50,$E($P(IBRVCD,U,2),1,28)
- I +$P(IBCI0,U,7) W ?70,$$EXPAND^IBCRU1(363.2,.07,+$P(IBCI0,U,7))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRU5 2611 printed Mar 13, 2025@21:24:59 Page 2
- IBCRU5 ;ALB/ARH - RATES: UTILITIES (DISPLAYS) ; 16-MAY-1996
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- DISPCS(IBCSFN) ; display charge set data
- +1 NEW IBCS0,IBBR0,IBRVCD,IBX
- SET IBCSFN=+$GET(IBCSFN)
- +2 SET IBCS0=$GET(^IBE(363.1,IBCSFN,0))
- SET IBBR0=$GET(^IBE(363.3,+$PIECE(IBCS0,U,2),0))
- SET IBRVCD=$GET(^DGCR(399.2,+$PIECE(IBCS0,U,5),0))
- +3 ;
- +4 WRITE !!!,?4,"Charge Set: ",?19,$EXTRACT($PIECE(IBCS0,U,1),1,30)
- +5 IF +$PIECE(IBCS0,U,4)
- WRITE ?49,"Charge Type: ",?65,$$EXPAND^IBCRU1(363.1,.04,+$PIECE(IBCS0,U,4))
- +6 WRITE !,?4,"Billing Event: ",?19,$EXTRACT($$EMUTL^IBCRU1($PIECE(IBCS0,U,3),1),1,28)
- +7 WRITE ?49,"Default Rev Cd: ",?65,$PIECE(IBRVCD,U,1)
- +8 WRITE !,?4,"Billing Rate: ",?19,$EXTRACT($PIECE(IBBR0,U,1),1,28)
- +9 WRITE ?49,"Default Bed: ",?65,$EXTRACT($$EMUTL^IBCRU1(+$PIECE(IBCS0,U,6),2),1,15)
- +10 IF +$PIECE(IBCS0,U,7)
- SET IBX=$$RGEXT^IBCRU4(+$PIECE(IBCS0,U,7))
- IF IBX'=""
- WRITE !,?4,"Region: ",?19,$PIECE(IBX,U,1)
- if ($LENGTH($PIECE(IBX,U,2))>40)
- WRITE !,?17
- WRITE " (",$PIECE(IBX,U,2),")"
- +11 IF +$PIECE(IBCS0,U,5)
- WRITE !!,?4,"All Charge Items will use Rev Code ",$PIECE(IBRVCD,U,1)," if one is not specified for the Item."
- +12 IF '$PIECE(IBCS0,U,5)
- WRITE !!,?4,"A Default Rev Code is not specified, one will be required for each Item."
- +13 IF +$PIECE(IBBR0,U,4)
- WRITE !,?4,"All items billable to the ",$PIECE(IBBR0,U,2)," Billing Rate must be ",$$EXPAND^IBCRU1(363.3,.04,+$PIECE(IBBR0,U,4)),"s.",!!
- +14 IF '$PIECE(IBBR0,U,4)
- WRITE !,?4,"The ",$PIECE(IBBR0,U,2)," Billing Rate charges are calculated, there are no Charge Items.",!!
- +15 QUIT
- +16 ;
- DISPCSL(IBCSFN) ; display one line of charge set data
- +1 NEW IBCS0,IBRVCD
- IF '$GET(IBCSFN)
- QUIT
- +2 SET IBCS0=$GET(^IBE(363.1,IBCSFN,0))
- SET IBRVCD=$GET(^DGCR(399.2,+$PIECE(IBCS0,U,5),0))
- +3 IF IBCS0'=""
- WRITE !!,?4,"Set: ",$EXTRACT($PIECE(IBCS0,U,1),1,30),?55,"Default Rev Cd: ",$PIECE(IBRVCD,U,1)
- +4 QUIT
- +5 ;
- DISPCI(IBCSFN,IBCISI) ; display all Charge Items for a single billable event for a Charge Set
- +1 ; input IBCISI = pointer to the items source file (not the CI FN)
- +2 NEW XREF,IBEFDT,IBDA,IBCI0
- +3 SET IBCSFN=+$GET(IBCSFN)
- SET IBCISI=+$GET(IBCISI)
- SET XREF="AIVDTS"_IBCSFN
- WRITE !
- +4 SET IBEFDT=-99999999
- FOR
- SET IBEFDT=$ORDER(^IBA(363.2,XREF,IBCISI,IBEFDT))
- if 'IBEFDT
- QUIT
- Begin DoDot:1
- +5 SET IBDA=0
- FOR
- SET IBDA=$ORDER(^IBA(363.2,XREF,IBCISI,IBEFDT,IBDA))
- if 'IBDA
- QUIT
- Begin DoDot:2
- +6 DO DISPCIL(IBDA)
- End DoDot:2
- End DoDot:1
- +7 WRITE !
- +8 QUIT
- +9 ;
- DISPCIL(IBDA,IBCNT) ; print a single Charge Item line (input: IBDA = CI IFN, IBCNT = reference #)
- +1 NEW IBCI0,IBRVCD
- SET IBCI0=$GET(^IBA(363.2,+$GET(IBDA),0))
- if 'IBCI0
- QUIT
- +2 WRITE !,?5,$GET(IBCNT)
- +3 WRITE ?10,$$DATE^IBCRU1($PIECE(IBCI0,U,3))
- +4 IF +$PIECE(IBCI0,U,4)
- WRITE ?19,"- ",$$DATE^IBCRU1($PIECE(IBCI0,U,4))
- +5 WRITE ?30,$JUSTIFY($PIECE(IBCI0,U,5),10,2)
- +6 SET IBRVCD=$GET(^DGCR(399.2,+$PIECE(IBCI0,U,6),0))
- +7 WRITE ?45,$PIECE(IBRVCD,U,1),?50,$EXTRACT($PIECE(IBRVCD,U,2),1,28)
- +8 IF +$PIECE(IBCI0,U,7)
- WRITE ?70,$$EXPAND^IBCRU1(363.2,.07,+$PIECE(IBCI0,U,7))
- +9 QUIT
