source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCRLG.m@ 1487

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1IBCRLG ;ALB/ARH - RATES: DISPLAY BILLING REGIONS ; 16-MAY-1996
2 ;;2.0;INTEGRATED BILLING;**52,115,138,245**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCR BILLING REGION
6 D EN^VALM("IBCR BILLING REGION")
7 Q
8 ;
9HDR ; -- header code
10 S VALMHDR(1)="Regions/localities covered by the same charges"
11 Q
12 ;
13INIT ; -- init variables and list array
14 K ^TMP("IBCRLG",$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("IBCRLG",$J)
24 D CLEAR^VALM1,CLEAN^VALM10
25 Q
26 ;
27BLD ; build LM array for billing region display
28 N IBRGN,IBRGFN,IBRG0,IBDVN,IBDV0,IBX,IBY,IBIST,IBIS0 S VALMCNT=0
29 ;
30 ; create LM display array
31 S IBRGN="" F S IBRGN=$O(^IBE(363.31,"B",IBRGN)) Q:IBRGN="" D
32 . S IBRGFN=0 F S IBRGFN=$O(^IBE(363.31,"B",IBRGN,IBRGFN)) Q:'IBRGFN D
33 .. S IBRG0=$G(^IBE(363.31,IBRGFN,0)) Q:IBRG0=""
34 .. D SET("") S IBY=""
35 .. ;
36 .. S IBX=$P(IBRG0,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
37 .. S IBX=$P(IBRG0,U,2)_"-"_$P(IBRG0,U,3),IBY=$$SETFLD^VALM1(IBX,IBY,"ID")
38 .. ;
39 .. S IBDVN=0 F S IBDVN=$O(^IBE(363.31,IBRGFN,11,IBDVN)) Q:'IBDVN D
40 ... S IBDV0=$G(^IBE(363.31,IBRGFN,11,IBDVN,0)) Q:IBDV0=""
41 ... ;
42 ... I IBY'="" S IBX=$J("Division:",12),IBY=$$SETFLD^VALM1(IBX,IBY,"TYPE")
43 ... S IBX=$G(^DG(40.8,+IBDV0,0)),IBX=$E(($P(IBX,U,2)_" "),1,6)_$P(IBX,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DI")
44 ... ;
45 ... D SET(IBY) S IBY=""
46 .. ;
47 .. ; institutions for transfer pricing
48 .. S IBIST=0 F S IBIST=$O(^IBE(363.31,IBRGFN,21,IBIST)) Q:'IBIST D
49 ... S IBIS0=$G(^IBE(363.31,IBRGFN,21,IBIST,0)) Q:IBIS0=""
50 ... ;
51 ... I IBY'="" S IBX=$J("Institution:",12),IBY=$$SETFLD^VALM1(IBX,IBY,"TYPE")
52 ... S IBX=$P($$NNT^XUAF4(+IBIS0),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DI")
53 ... ;
54 ... D SET(IBY) S IBY=""
55 .. ;
56 .. I IBY'="" D SET(IBY)
57 ;
58 I VALMCNT=0 D SET(" "),SET("No Billing Regions defined")
59 ;
60 Q
61 ;
62SET(X) ; set up list manager screen array
63 S VALMCNT=VALMCNT+1
64 S ^TMP("IBCRLG",$J,VALMCNT,0)=X
65 Q
Note: See TracBrowser for help on using the repository browser.