| 1 | IBCRLC ;ALB/ARH - RATES: DISPLAY CHARGE SETS ; 17-MAY-1996
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,106**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBCR CHARGE SET
|
|---|
| 6 | D EN^VALM("IBCR CHARGE SET")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)=" Default"
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
|
|---|
| 15 | D BLD
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | HELP ; -- help code
|
|---|
| 19 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | EXIT ; -- exit code
|
|---|
| 23 | K ^TMP("IBCRLC",$J),^TMP("IBCRLCX1",$J)
|
|---|
| 24 | D CLEAR^VALM1,CLEAN^VALM10
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BLD ; build charge set display array
|
|---|
| 28 | N IBBRNM,IBBRFN,IBCSNM,IBCSFN,IBBEVNT,IBLN,IBX,IBY S VALMCNT=0 K ^TMP($J,"IBCRCS")
|
|---|
| 29 | ;
|
|---|
| 30 | D SORTCS
|
|---|
| 31 | ;
|
|---|
| 32 | ; create LM display array
|
|---|
| 33 | S IBBRNM="" F S IBBRNM=$O(^TMP($J,"IBCRCS",IBBRNM)) Q:IBBRNM="" D
|
|---|
| 34 | . ;
|
|---|
| 35 | . S IBBRFN=+$G(^TMP($J,"IBCRCS",IBBRNM))
|
|---|
| 36 | . D SET("",IBBRFN) S IBY=" Billing Rate: "_IBBRNM
|
|---|
| 37 | . D SET(IBY) D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
|
|---|
| 38 | . ;
|
|---|
| 39 | . S IBBEVNT="" F S IBBEVNT=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT)) Q:IBBEVNT="" D
|
|---|
| 40 | .. S IBCSNM="" F S IBCSNM=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM)) Q:IBCSNM="" D
|
|---|
| 41 | ... S IBCSFN=0 F S IBCSFN=$O(^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,IBCSNM,IBCSFN)) Q:'IBCSFN D
|
|---|
| 42 | .... ;
|
|---|
| 43 | .... S IBLN=$G(^IBE(363.1,IBCSFN,0)) Q:IBLN=""
|
|---|
| 44 | .... S IBY=""
|
|---|
| 45 | .... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"CGSET")
|
|---|
| 46 | .... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,3),2),IBY=$$SETFLD^VALM1(IBX,IBY,"BEVNT")
|
|---|
| 47 | .... S IBX=$$CGTYPE(+$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"CGTYP")
|
|---|
| 48 | .... S IBX=$P($G(^DGCR(399.2,+$P(IBLN,U,5),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DRVCD")
|
|---|
| 49 | .... S IBX=$$EMUTL^IBCRU1(+$P(IBLN,U,6),2),IBY=$$SETFLD^VALM1(IBX,IBY,"DBEDS")
|
|---|
| 50 | .... S IBX=$P($G(^IBE(363.31,+$P(IBLN,U,7),0)),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
|
|---|
| 51 | .... D SET(IBY)
|
|---|
| 52 | ;
|
|---|
| 53 | I VALMCNT=0 D SET(" ",0),SET("No Charge Sets defined",0)
|
|---|
| 54 | ;
|
|---|
| 55 | K ^TMP($J,"IBCRCS")
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | SET(X,BRFN) ; set up list manager screen array
|
|---|
| 59 | S VALMCNT=VALMCNT+1
|
|---|
| 60 | S ^TMP("IBCRLC",$J,VALMCNT,0)=X
|
|---|
| 61 | I +$G(BRFN) S ^TMP("IBCRLCX1",$J,+BRFN)=VALMCNT
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | SORTCS ; created array of all Charge Sets sorted by billing rate, billable event, and Charge Set name
|
|---|
| 65 | ; ^TMP($J,"IBCRCS", billing rate name) = billing rate IFN
|
|---|
| 66 | ; ^TMP($J,"IBCRCS", billing rate name, billable event, charge set name, charge set IFN) = ""
|
|---|
| 67 | N IBCSFN,IBBRNM,IBBEVNT,IBLN
|
|---|
| 68 | S IBCSFN=0 F S IBCSFN=$O(^IBE(363.1,IBCSFN)) Q:'IBCSFN D
|
|---|
| 69 | . S IBLN=$G(^IBE(363.1,IBCSFN,0))
|
|---|
| 70 | . S IBBRNM=$P($G(^IBE(363.3,+$P(IBLN,U,2),0)),U,1) I IBBRNM="" S IBBRNM=" "
|
|---|
| 71 | . S IBBEVNT=$$EMUTL^IBCRU1($P(IBLN,U,3),2) I IBBEVNT="" S IBBEVNT=" "
|
|---|
| 72 | . S ^TMP($J,"IBCRCS",IBBRNM)=$P(IBLN,U,2)
|
|---|
| 73 | . S ^TMP($J,"IBCRCS",IBBRNM,IBBEVNT,$P(IBLN,U,1),IBCSFN)=""
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | CGTYPE(X) ; return external form of Charge Type (363.1)
|
|---|
| 77 | S X=$G(X),X=$S(X=1:"INSTITUTIONAL",X=2:"PROFESSIONAL",1:"")
|
|---|
| 78 | Q X
|
|---|
