source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRLR.m@ 823

Last change on this file since 823 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IBCRLR ;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 ;
5EN ; -- main entry point for IBCR BILLING RATE
6 D EN^VALM("IBCR BILLING RATE")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)=""
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBCRLR",$J)
15 D BLD
16 Q
17 ;
18HELP ; -- help code
19 S X="?" D DISP^XQORM1 W !!
20 Q
21 ;
22EXIT ; -- exit code
23 K ^TMP("IBCRLR",$J)
24 D CLEAR^VALM1,CLEAN^VALM10
25 Q
26 ;
27BLD ; 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 ;
52SET(X) ; set up list manager screen array
53 S VALMCNT=VALMCNT+1
54 S ^TMP("IBCRLR",$J,VALMCNT,0)=X
55 Q
56 ;
57SORTBR ; 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
Note: See TracBrowser for help on using the repository browser.