Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCRLG

IBCRLG.m

Go to the documentation of this file.
  1. IBCRLG ;ALB/ARH - RATES: DISPLAY BILLING REGIONS ; 16-MAY-1996
  1. ;;2.0;INTEGRATED BILLING;**52,115,138,245**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for IBCR BILLING REGION
  1. D EN^VALM("IBCR BILLING REGION")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="Regions/localities covered by the same charges"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP("IBCRLG",$J)
  1. D BLD
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("IBCRLG",$J)
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. BLD ; build LM array for billing region display
  1. N IBRGN,IBRGFN,IBRG0,IBDVN,IBDV0,IBX,IBY,IBIST,IBIS0 S VALMCNT=0
  1. ;
  1. ; create LM display array
  1. S IBRGN="" F S IBRGN=$O(^IBE(363.31,"B",IBRGN)) Q:IBRGN="" D
  1. . S IBRGFN=0 F S IBRGFN=$O(^IBE(363.31,"B",IBRGN,IBRGFN)) Q:'IBRGFN D
  1. .. S IBRG0=$G(^IBE(363.31,IBRGFN,0)) Q:IBRG0=""
  1. .. D SET("") S IBY=""
  1. .. ;
  1. .. S IBX=$P(IBRG0,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"REGN")
  1. .. S IBX=$P(IBRG0,U,2)_"-"_$P(IBRG0,U,3),IBY=$$SETFLD^VALM1(IBX,IBY,"ID")
  1. .. ;
  1. .. S IBDVN=0 F S IBDVN=$O(^IBE(363.31,IBRGFN,11,IBDVN)) Q:'IBDVN D
  1. ... S IBDV0=$G(^IBE(363.31,IBRGFN,11,IBDVN,0)) Q:IBDV0=""
  1. ... ;
  1. ... I IBY'="" S IBX=$J("Division:",12),IBY=$$SETFLD^VALM1(IBX,IBY,"TYPE")
  1. ... 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")
  1. ... ;
  1. ... D SET(IBY) S IBY=""
  1. .. ;
  1. .. ; institutions for transfer pricing
  1. .. S IBIST=0 F S IBIST=$O(^IBE(363.31,IBRGFN,21,IBIST)) Q:'IBIST D
  1. ... S IBIS0=$G(^IBE(363.31,IBRGFN,21,IBIST,0)) Q:IBIS0=""
  1. ... ;
  1. ... I IBY'="" S IBX=$J("Institution:",12),IBY=$$SETFLD^VALM1(IBX,IBY,"TYPE")
  1. ... S IBX=$P($$NNT^XUAF4(+IBIS0),U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"DI")
  1. ... ;
  1. ... D SET(IBY) S IBY=""
  1. .. ;
  1. .. I IBY'="" D SET(IBY)
  1. ;
  1. I VALMCNT=0 D SET(" "),SET("No Billing Regions defined")
  1. ;
  1. Q
  1. ;
  1. SET(X) ; set up list manager screen array
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("IBCRLG",$J,VALMCNT,0)=X
  1. Q