Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCRLI

IBCRLI.m

Go to the documentation of this file.
  1. IBCRLI ;ALB/ARH - RATES: DISPLAY CHARGE ITEMS ; 16-MAY-1996
  1. ;;2.0;INTEGRATED BILLING;**52,106,245**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; if Charge Set/Rates Billable Item is Bedsection then default display is current charge for all items
  1. ; all other Charge Sets display all charges for a user selected item
  1. ; this is due to unknown number of possible entries, for example a CPT set may have thousands of current charges
  1. ;
  1. EN ; -- main entry point for IBCR CHARGE ITEM
  1. D EN^VALM("IBCR CHARGE ITEM")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N IBY,IBX,IBZ,IBI,IBK S IBI=1,(IBX,IBY,IBZ,IBK,VALMHDR(1),VALMHDR(2))=""
  1. ;
  1. I +$P(IBCS0,U,5) S IBK="Default Revenue Code: "_$P($G(^DGCR(399.2,+$P(IBCS0,U,5),0)),U,1)
  1. ;
  1. S IBZ=IBBRBIN_$S(+IBSRNITM:" ",1:"")_$P(IBSRNITM,U,2)_" items billable to Charge Set "
  1. ;
  1. S IBX=$P(IBCS0,U,1) I +$G(IBSRNBDT)!(+$G(IBSRNEDT)) D
  1. . I IBSRNBDT=IBSRNEDT S IBX=$E(IBX,1,28),IBY=" on "_$$DATE(IBSRNBDT) Q
  1. . I 'IBSRNBDT S IBY=" on or before "_$$DATE(IBSRNEDT) Q
  1. . I 'IBSRNEDT S IBY=" on or after "_$$DATE(IBSRNBDT) Q
  1. . I IBSRNBDT'=IBSRNEDT S IBY=" between "_$$DATE(IBSRNBDT)_" and "_$$DATE(IBSRNEDT)
  1. ;
  1. S VALMHDR(1)=IBZ_IBX
  1. I ($L(IBZ)+$L(IBX)+$L(IBY))<80 S VALMHDR(1)=VALMHDR(1)_IBY,IBY=""
  1. S VALMHDR(2)=IBK_$J("",(80-($L(IBK)+$L(IBY))))_IBY
  1. Q
  1. ;
  1. INIT ; -- init variables and list array IBCSFN required
  1. K ^TMP("IBCRLI",$J)
  1. I '$G(IBCSFN) S IBCSFN=$$GETCS^IBCRU1 I IBCSFN'>0 S VALMQUIT="" Q
  1. I $$GET(IBCSFN)<0 S VALMQUIT="" Q
  1. D BLD
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("IBCRLI",$J),IBCS0,IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. BLD ; build array for display for Charge Item display: charge set required
  1. N IBITEM,IBDT1,IBCIFN,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCI")
  1. S IBSRNITM=$G(IBSRNITM),IBSRNBDT=$G(IBSRNBDT),IBSRNEDT=$G(IBSRNEDT)
  1. ;
  1. I (IBBRBI=1)!(+IBSRNITM) D SORTCI(IBCSFN,$G(IBSRNITM),$G(IBSRNBDT),$G(IBSRNEDT))
  1. ;
  1. ; create LM diplay array of charge items
  1. S IBITEM="" F S IBITEM=$O(^TMP($J,"IBCRCI",IBITEM)) Q:IBITEM="" D
  1. . S IBDT1="" F S IBDT1=$O(^TMP($J,"IBCRCI",IBITEM,IBDT1)) Q:IBDT1="" D
  1. .. S IBCIFN=0 F S IBCIFN=$O(^TMP($J,"IBCRCI",IBITEM,IBDT1,IBCIFN)) Q:'IBCIFN D
  1. ... ;
  1. ... S IBLN=$G(^IBA(363.2,IBCIFN,0)),IBY=""
  1. ... S IBX=$$EXPAND^IBCRU1(363.2,.01,$P(IBLN,U,1))
  1. ... I +$P(IBLN,U,7) S IBX=IBX_" - "_$$EXPAND^IBCRU1(363.2,.07,+$P(IBLN,U,7))
  1. ... S IBY=$$SETFLD^VALM1(IBX,IBY,"ITEM")
  1. ... S IBX=$J($P(IBLN,U,5),8,2),IBY=$$SETFLD^VALM1(IBX,IBY,"UCHG")
  1. ... S IBX=$J($P(IBLN,U,8),8,2),IBY=$$SETFLD^VALM1(IBX,IBY,"BCHG")
  1. ... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,6),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RVCD")
  1. ... S IBX=$$DATE($P(IBLN,U,3)),IBY=$$SETFLD^VALM1(IBX,IBY,"EFFDT")
  1. ... S IBX=$P(IBLN,U,4)
  1. ... I +IBX S IBY=$$SETFLD^VALM1("-",IBY,"DS"),IBX=$$DATE(IBX),IBY=$$SETFLD^VALM1(IBX,IBY,"INADT")
  1. ... D SET(IBY)
  1. ;
  1. I VALMCNT=0 D SET(" ") D
  1. . I 'IBBRBI D SET("The Billing Rate of this Set has no Billable Item defined, therefore no"),SET("Charge Items may be defined for it. (The charges may be calculated amounts.)") Q
  1. . I '$D(^IBA(363.2,"AIVDTS"_+$G(IBCSFN))) D SET("No Charge Items defined for this Set.") Q
  1. . I +IBSRNITM,'$D(^IBA(363.2,"AIVDTS"_+$G(IBCSFN),+IBSRNITM)) D SET(IBBRBIN_" "_$P(IBSRNITM,U,2)_" has no charges for this set.") Q
  1. . I 'IBSRNITM,IBBRBI'=1 D SET("No Charge Item chosen for display:"),SET(" - Non-bedsection type Items must be specifically chosen for display."),SET(" - Use the CI action and select an item to display.") Q
  1. . I 'IBSRNITM D SET("This set has no charges in this date range.") Q
  1. . D SET(IBBRBIN_" "_$P(IBSRNITM,U,2)_" has no charges for this set in this date range.")
  1. ;
  1. K ^TMP($J,"IBCRCI")
  1. Q
  1. ;
  1. DATE(X) ; date in external format
  1. N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1. Q Y
  1. ;
  1. SET(X) ; set up list manager screen array
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("IBCRLI",$J,VALMCNT,0)=X
  1. Q
  1. ;
  1. ;
  1. SORTCI(IBCSFN,IBITM,IBDT1,IBDT2) ; sort a charge sets items by item name and inverse effective date
  1. ; if ITEM is not defined than dates should be, if ITEM or dates not defined then assumes all should be included
  1. ; ^TMP("IBCRCI",$J, item name, - effective date, ITEM IFN)=""
  1. ;
  1. N IBXRF,IBBITM,IBEITM,IBITEM,IBBDT,IBEDT,IBEFDT,IBCIFN,IBLN,IBITEMN
  1. ;
  1. S IBXRF="AIVDTS"_+$G(IBCSFN)
  1. S IBBITM=+$G(IBITM)-.0001,IBEITM=$S(+$G(IBITM):IBITM,1:9999999999)
  1. S IBBDT=$S(+$G(IBDT1):-IBDT1,1:-1000000),IBEDT=$S(+$G(IBDT2):-(IBDT2+.01),1:-9999999) Q:IBBDT<IBEDT
  1. ;
  1. S IBITEM=IBBITM F S IBITEM=$O(^IBA(363.2,IBXRF,IBITEM)) Q:'IBITEM!(IBITEM>IBEITM) D
  1. . S IBEFDT=IBEDT F S IBEFDT=$O(^IBA(363.2,IBXRF,IBITEM,IBEFDT)) Q:'IBEFDT D Q:(IBEFDT'<IBBDT)
  1. .. S IBCIFN=0 F S IBCIFN=$O(^IBA(363.2,IBXRF,IBITEM,IBEFDT,IBCIFN)) Q:'IBCIFN D
  1. ... S IBLN=$G(^IBA(363.2,IBCIFN,0)),IBITEMN=$$EXPAND^IBCRU1(363.2,.01,$P(IBLN,U,1))_" - "
  1. ... I +$P(IBLN,U,7) S IBITEMN=IBITEMN_$$EXPAND^IBCRU1(363.2,.07,+$P(IBLN,U,7))
  1. ... I $P(IBLN,U,4),+$P(IBLN,U,4)<-IBBDT Q
  1. ... S ^TMP($J,"IBCRCI",IBITEMN,IBEFDT,IBCIFN)=""
  1. Q
  1. ;
  1. GET(IBCSFN) ; get item to display on screen for specific charge set, set up general variables required
  1. ; (returns 0 if error, -1 if ^) all active bedsections or all entries for a specific CPT or NDC #
  1. ;
  1. ; returns general data on the Charge set to be diplayed, may ask user for a specific item
  1. ; variables defined on exit: IBCS0,IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT
  1. ; if billable item is bedsection returns current date but no item
  1. ; if billable item is anything else asks user for specific item but returns no date
  1. ;
  1. N IBX S IBX=1,(IBBRBI,IBBRBIN,IBSRNITM,IBSRNBDT,IBSRNEDT)=""
  1. S IBCS0=$G(^IBE(363.1,+$G(IBCSFN),0)) I IBCS0="" S IBX=0 G GETQ
  1. S IBBRBI=$P($G(^IBE(363.3,+$P(IBCS0,U,2),0)),U,4) I 'IBBRBI S IBX=0 G GETQ
  1. S IBBRBIN=$$EXPAND^IBCRU1(363.3,.04,IBBRBI)
  1. I IBBRBI>1 W !!,"Select a billable ",IBBRBIN," to display for Charge Set ",$P(IBCS0,U,1),!
  1. ;
  1. I IBBRBI=1 S (IBSRNBDT,IBSRNEDT)=DT ; all currently active charges (bedsection)
  1. I IBBRBI=2 S (IBX,IBSRNITM)=$$GETCPT^IBCRU1("",1) ; all charges for a specific CPT
  1. I IBBRBI=3 S (IBX,IBSRNITM)=$$GETNDC^IBCRU1 ; all charges for a specific NDC #
  1. I IBBRBI=4 S (IBX,IBSRNITM)=$$GETDRG^IBCRU1 ; all charges for a specific DRG
  1. I IBBRBI=9 S (IBX,IBSRNITM)=$$GETMISC^IBCRU1 ; all charges for a specific MISCELLANEOUS item
  1. GETQ Q IBX