79 lines
2.8 KiB
Mathematica
79 lines
2.8 KiB
Mathematica
IBCRLC ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-MAY-1996
|
|
;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94
|
|
;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
EN ; -- main entry point for IBCR CHARGE SET
|
|
D EN^VALM("IBCR CHARGE SET")
|
|
Q
|
|
;
|
|
HDR ; -- header code
|
|
S VALMHDR(1)=" Default"
|
|
Q
|
|
;
|
|
INIT ; -- init variables and list array
|
|
K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
|
|
D BLD
|
|
Q
|
|
;
|
|
HELP ; -- help code
|
|
S X="?" D DISP^XQORM1 W !!
|
|
Q
|
|
;
|
|
EXIT ; -- exit code
|
|
K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
|
|
D CLEAR^VALM1,CLEAN^VALM10
|
|
Q
|
|
;
|
|
BLD ; build charge set display array
|
|
N IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCS")
|
|
;
|
|
D SORTCS
|
|
;
|
|
; create LM display array
|
|
S IBBRNM="" F S IBBRNM=$O(^TMP($J,"IBCRCS",IBBRNM)) Q:IBBRNM="" D
|
|
. ;
|
|
. S IBBRFN=+$G(^TMP($J,"IBCRCS",IBBRNM))
|
|
. D SET("",IBBRFN) S IBY=" Billing Rate: "_IBBRNM
|
|
. D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
|
|
. ;
|
|
. S IBBEVNT="" F S IBBEVNT=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT)) Q:IBBEVNT="" D
|
|
.. S IBCSNM="" F S IBCSNM=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM)) Q:IBCSNM="" D
|
|
... S IBCSFN=0 F S IBCSFN=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN)) Q:'IBCSFN D
|
|
.... ;
|
|
.... S IBLN=$G(^IBE(363.1,IBCSFN,0)) Q:IBLN=""
|
|
.... S IBY=""
|
|
.... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")
|
|
.... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,3),2),IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")
|
|
.... S IBX=$$CGTYPE(+$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")
|
|
.... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,5),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")
|
|
.... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,6),2),IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")
|
|
.... S IBX=$P($G(^IBE(363.31,+$P(IBLN,U,7),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
|
|
.... D SET(IBY)
|
|
;
|
|
I VALMCNT=0 D SET(" ",0),SET("No Charge Sets defined",0)
|
|
;
|
|
K ^TMP($J,"IBCRCS")
|
|
Q
|
|
;
|
|
SET(X,BRFN) ; set up list manager screen array
|
|
S VALMCNT=VALMCNT+1
|
|
S ^TMP("IBCRLC",$J,VALMCNT,0)=X
|
|
I +$G(BRFN) S ^TMP("IBCRLCX1",$J,+BRFN)=VALMCNT
|
|
Q
|
|
;
|
|
SORTCS ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name
|
|
; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN
|
|
; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""
|
|
N IBCSFN,IBBRNM,IBBEVNT,IBLN
|
|
S IBCSFN=0 F S IBCSFN=$O(^IBE(363.1,IBCSFN)) Q:'IBCSFN D
|
|
. S IBLN=$G(^IBE(363.1,IBCSFN,0))
|
|
. S IBBRNM=$P($G(^IBE(363.3,+$P(IBLN,U,2),0)),U,1) I IBBRNM="" S IBBRNM=" "
|
|
. S IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3),2) I IBBEVNT="" S IBBEVNT=" "
|
|
. S ^TMP($J,"IBCRCS",IBBRNM)=$P(IBLN,U,2)
|
|
. S ^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,$P(IBLN,U,1),IBCSFN)=""
|
|
Q
|
|
;
|
|
CGTYPE(X) ; return external form of Charge Type (363.1)
|
|
S X=$G(X),X=$S(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")
|
|
Q X
|