| 1 | IBCRLR ;ALB/ARH - RATES: DISPLAY BILLING RATES ; 16-MAY-1996
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; -- main entry point for IBCR BILLING RATE
|
|---|
| 6 | D EN^VALM("IBCR BILLING RATE")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)=""
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBCRLR",$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("IBCRLR",$J)
|
|---|
| 24 | D CLEAR^VALM1,CLEAN^VALM10
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BLD ; build array for billing rate display
|
|---|
| 28 | N IBDSTR,IBBRN,IBBRFN,IBLN,IBCNT,IBX,IBY S VALMCNT=0,IBCNT=0 K ^TMP($J,"IBCRBR")
|
|---|
| 29 | ;
|
|---|
| 30 | D SORTBR
|
|---|
| 31 | ;
|
|---|
| 32 | ; create LM display array
|
|---|
| 33 | S IBDSTR=0 F S IBDSTR=$O(^TMP($J,"IBCRBR",IBDSTR)) Q:'IBDSTR D
|
|---|
| 34 | . D SET("")
|
|---|
| 35 | . S IBBRN="" F S IBBRN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN)) Q:IBBRN="" D
|
|---|
| 36 | .. S IBBRFN=0 F S IBBRFN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN,IBBRFN)) Q:'IBBRFN D
|
|---|
| 37 | ... ;
|
|---|
| 38 | ... S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
|
|---|
| 39 | ... S IBCNT=IBCNT+1,IBY=""
|
|---|
| 40 | ... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RATE")
|
|---|
| 41 | ... S IBX=$P(IBLN,U,2),IBY=$$SETFLD^VALM1(IBX,IBY,"ABBV")
|
|---|
| 42 | ... S IBX=$$EXPAND^IBCRU1(363.3,.03,$P(IBLN,U,3)),IBY=$$SETFLD^VALM1(IBX,IBY,"DSTR")
|
|---|
| 43 | ... S IBX=$$EXPAND^IBCRU1(363.3,.04,$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"BITM")
|
|---|
| 44 | ... S IBX=$$EXPAND^IBCRU1(363.3,.05,$P(IBLN,U,5)),IBY=$$SETFLD^VALM1(IBX,IBY,"CMTHD")
|
|---|
| 45 | ... D SET(IBY)
|
|---|
| 46 | ;
|
|---|
| 47 | I VALMCNT=0 D SET(" "),SET("No Billing Rates defined")
|
|---|
| 48 | ;
|
|---|
| 49 | K ^TMP($J,"IBCRBR")
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | SET(X) ; set up list manager screen array
|
|---|
| 53 | S VALMCNT=VALMCNT+1
|
|---|
| 54 | S ^TMP("IBCRLR",$J,VALMCNT,0)=X
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | SORTBR ; sort billing rates by distribution and billing rate name
|
|---|
| 58 | ; ^TMP($J,"IBCRBR", national/local grouping , billing rate name, IBBRFN)=""
|
|---|
| 59 | N IBBRFN,IBLN,IBDSTR
|
|---|
| 60 | S IBBRFN=0 F S IBBRFN=$O(^IBE(363.3,IBBRFN)) Q:'IBBRFN D
|
|---|
| 61 | . S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
|
|---|
| 62 | . S IBDSTR=$P(IBLN,U,3) I IBDSTR=2,IBBRFN<1000 S IBDSTR=1.5
|
|---|
| 63 | . I 'IBDSTR S IBDSTR=9999
|
|---|
| 64 | . S ^TMP($J,"IBCRBR",IBDSTR,$P(IBLN,U,1),IBBRFN)=""
|
|---|
| 65 | Q
|
|---|
