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

IBCRLR.m

Go to the documentation of this file.
  1. IBCRLR ;ALB/ARH - RATES: DISPLAY BILLING RATES ; 16-MAY-1996
  1. ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 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 RATE
  1. D EN^VALM("IBCR BILLING RATE")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)=""
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP("IBCRLR",$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("IBCRLR",$J)
  1. D CLEAR^VALM1,CLEAN^VALM10
  1. Q
  1. ;
  1. BLD ; build array for billing rate display
  1. N IBDSTR,IBBRN,IBBRFN,IBLN,IBCNT,IBX,IBY S VALMCNT=0,IBCNT=0 K ^TMP($J,"IBCRBR")
  1. ;
  1. D SORTBR
  1. ;
  1. ; create LM display array
  1. S IBDSTR=0 F S IBDSTR=$O(^TMP($J,"IBCRBR",IBDSTR)) Q:'IBDSTR D
  1. . D SET("")
  1. . S IBBRN="" F S IBBRN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN)) Q:IBBRN="" D
  1. .. S IBBRFN=0 F S IBBRFN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN,IBBRFN)) Q:'IBBRFN D
  1. ... ;
  1. ... S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
  1. ... S IBCNT=IBCNT+1,IBY=""
  1. ... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RATE")
  1. ... S IBX=$P(IBLN,U,2),IBY=$$SETFLD^VALM1(IBX,IBY,"ABBV")
  1. ... S IBX=$$EXPAND^IBCRU1(363.3,.03,$P(IBLN,U,3)),IBY=$$SETFLD^VALM1(IBX,IBY,"DSTR")
  1. ... S IBX=$$EXPAND^IBCRU1(363.3,.04,$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"BITM")
  1. ... S IBX=$$EXPAND^IBCRU1(363.3,.05,$P(IBLN,U,5)),IBY=$$SETFLD^VALM1(IBX,IBY,"CMTHD")
  1. ... D SET(IBY)
  1. ;
  1. I VALMCNT=0 D SET(" "),SET("No Billing Rates defined")
  1. ;
  1. K ^TMP($J,"IBCRBR")
  1. Q
  1. ;
  1. SET(X) ; set up list manager screen array
  1. S VALMCNT=VALMCNT+1
  1. S ^TMP("IBCRLR",$J,VALMCNT,0)=X
  1. Q
  1. ;
  1. SORTBR ; sort billing rates by distribution and billing rate name
  1. ; ^TMP($J,"IBCRBR", national/local grouping , billing rate name, IBBRFN)=""
  1. N IBBRFN,IBLN,IBDSTR
  1. S IBBRFN=0 F S IBBRFN=$O(^IBE(363.3,IBBRFN)) Q:'IBBRFN D
  1. . S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
  1. . S IBDSTR=$P(IBLN,U,3) I IBDSTR=2,IBBRFN<1000 S IBDSTR=1.5
  1. . I 'IBDSTR S IBDSTR=9999
  1. . S ^TMP($J,"IBCRBR",IBDSTR,$P(IBLN,U,1),IBBRFN)=""
  1. Q