| [613] | 1 | IBCRLG ;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 | ;
|
|---|
| 5 | EN ; -- main entry point for IBCR BILLING REGION
|
|---|
| 6 | D EN^VALM("IBCR BILLING REGION")
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | HDR ; -- header code
|
|---|
| 10 | S VALMHDR(1)="Regions/localities covered by the same charges"
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- init variables and list array
|
|---|
| 14 | K ^TMP("IBCRLG",$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("IBCRLG",$J)
|
|---|
| 24 | D CLEAR^VALM1,CLEAN^VALM10
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | BLD ; 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 | ;
|
|---|
| 62 | SET(X) ; set up list manager screen array
|
|---|
| 63 | S VALMCNT=VALMCNT+1
|
|---|
| 64 | S ^TMP("IBCRLG",$J,VALMCNT,0)=X
|
|---|
| 65 | Q
|
|---|
