- IBCRLR ;ALB/ARH - RATES: DISPLAY BILLING RATES ; 16-MAY-1996
- ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- EN ; -- main entry point for IBCR BILLING RATE
- D EN^VALM("IBCR BILLING RATE")
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)=""
- Q
- ;
- INIT ; -- init variables and list array
- K ^TMP("IBCRLR",$J)
- D BLD
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("IBCRLR",$J)
- D CLEAR^VALM1,CLEAN^VALM10
- Q
- ;
- BLD ; build array for billing rate display
- N IBDSTR,IBBRN,IBBRFN,IBLN,IBCNT,IBX,IBY S VALMCNT=0,IBCNT=0 K ^TMP($J,"IBCRBR")
- ;
- D SORTBR
- ;
- ; create LM display array
- S IBDSTR=0 F S IBDSTR=$O(^TMP($J,"IBCRBR",IBDSTR)) Q:'IBDSTR D
- . D SET("")
- . S IBBRN="" F S IBBRN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN)) Q:IBBRN="" D
- .. S IBBRFN=0 F S IBBRFN=$O(^TMP($J,"IBCRBR",IBDSTR,IBBRN,IBBRFN)) Q:'IBBRFN D
- ... ;
- ... S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
- ... S IBCNT=IBCNT+1,IBY=""
- ... S IBX=$P(IBLN,U,1),IBY=$$SETFLD^VALM1(IBX,IBY,"RATE")
- ... S IBX=$P(IBLN,U,2),IBY=$$SETFLD^VALM1(IBX,IBY,"ABBV")
- ... S IBX=$$EXPAND^IBCRU1(363.3,.03,$P(IBLN,U,3)),IBY=$$SETFLD^VALM1(IBX,IBY,"DSTR")
- ... S IBX=$$EXPAND^IBCRU1(363.3,.04,$P(IBLN,U,4)),IBY=$$SETFLD^VALM1(IBX,IBY,"BITM")
- ... S IBX=$$EXPAND^IBCRU1(363.3,.05,$P(IBLN,U,5)),IBY=$$SETFLD^VALM1(IBX,IBY,"CMTHD")
- ... D SET(IBY)
- ;
- I VALMCNT=0 D SET(" "),SET("No Billing Rates defined")
- ;
- K ^TMP($J,"IBCRBR")
- Q
- ;
- SET(X) ; set up list manager screen array
- S VALMCNT=VALMCNT+1
- S ^TMP("IBCRLR",$J,VALMCNT,0)=X
- Q
- ;
- SORTBR ; sort billing rates by distribution and billing rate name
- ; ^TMP($J,"IBCRBR", national/local grouping , billing rate name, IBBRFN)=""
- N IBBRFN,IBLN,IBDSTR
- S IBBRFN=0 F S IBBRFN=$O(^IBE(363.3,IBBRFN)) Q:'IBBRFN D
- . S IBLN=$G(^IBE(363.3,IBBRFN,0)) Q:IBLN=""
- . S IBDSTR=$P(IBLN,U,3) I IBDSTR=2,IBBRFN<1000 S IBDSTR=1.5
- . I 'IBDSTR S IBDSTR=9999
- . S ^TMP($J,"IBCRBR",IBDSTR,$P(IBLN,U,1),IBBRFN)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCRLR 2068 printed Feb 18, 2025@23:46:10 Page 2
- IBCRLR ;ALB/ARH - RATES: DISPLAY BILLING RATES ; 16-MAY-1996
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- EN ; -- main entry point for IBCR BILLING RATE
- +1 DO EN^VALM("IBCR BILLING RATE")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)=""
- +2 QUIT
- +3 ;
- INIT ; -- init variables and list array
- +1 KILL ^TMP("IBCRLR",$JOB)
- +2 DO BLD
- +3 QUIT
- +4 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("IBCRLR",$JOB)
- +2 DO CLEAR^VALM1
- DO CLEAN^VALM10
- +3 QUIT
- +4 ;
- BLD ; build array for billing rate display
- +1 NEW IBDSTR,IBBRN,IBBRFN,IBLN,IBCNT,IBX,IBY
- SET VALMCNT=0
- SET IBCNT=0
- KILL ^TMP($JOB,"IBCRBR")
- +2 ;
- +3 DO SORTBR
- +4 ;
- +5 ; create LM display array
- +6 SET IBDSTR=0
- FOR
- SET IBDSTR=$ORDER(^TMP($JOB,"IBCRBR",IBDSTR))
- if 'IBDSTR
- QUIT
- Begin DoDot:1
- +7 DO SET("")
- +8 SET IBBRN=""
- FOR
- SET IBBRN=$ORDER(^TMP($JOB,"IBCRBR",IBDSTR,IBBRN))
- if IBBRN=""
- QUIT
- Begin DoDot:2
- +9 SET IBBRFN=0
- FOR
- SET IBBRFN=$ORDER(^TMP($JOB,"IBCRBR",IBDSTR,IBBRN,IBBRFN))
- if 'IBBRFN
- QUIT
- Begin DoDot:3
- +10 ;
- +11 SET IBLN=$GET(^IBE(363.3,IBBRFN,0))
- if IBLN=""
- QUIT
- +12 SET IBCNT=IBCNT+1
- SET IBY=""
- +13 SET IBX=$PIECE(IBLN,U,1)
- SET IBY=$$SETFLD^VALM1(IBX,IBY,"RATE")
- +14 SET IBX=$PIECE(IBLN,U,2)
- SET IBY=$$SETFLD^VALM1(IBX,IBY,"ABBV")
- +15 SET IBX=$$EXPAND^IBCRU1(363.3,.03,$PIECE(IBLN,U,3))
- SET IBY=$$SETFLD^VALM1(IBX,IBY,"DSTR")
- +16 SET IBX=$$EXPAND^IBCRU1(363.3,.04,$PIECE(IBLN,U,4))
- SET IBY=$$SETFLD^VALM1(IBX,IBY,"BITM")
- +17 SET IBX=$$EXPAND^IBCRU1(363.3,.05,$PIECE(IBLN,U,5))
- SET IBY=$$SETFLD^VALM1(IBX,IBY,"CMTHD")
- +18 DO SET(IBY)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 ;
- +20 IF VALMCNT=0
- DO SET(" ")
- DO SET("No Billing Rates defined")
- +21 ;
- +22 KILL ^TMP($JOB,"IBCRBR")
- +23 QUIT
- +24 ;
- SET(X) ; set up list manager screen array
- +1 SET VALMCNT=VALMCNT+1
- +2 SET ^TMP("IBCRLR",$JOB,VALMCNT,0)=X
- +3 QUIT
- +4 ;
- SORTBR ; sort billing rates by distribution and billing rate name
- +1 ; ^TMP($J,"IBCRBR", national/local grouping , billing rate name, IBBRFN)=""
- +2 NEW IBBRFN,IBLN,IBDSTR
- +3 SET IBBRFN=0
- FOR
- SET IBBRFN=$ORDER(^IBE(363.3,IBBRFN))
- if 'IBBRFN
- QUIT
- Begin DoDot:1
- +4 SET IBLN=$GET(^IBE(363.3,IBBRFN,0))
- if IBLN=""
- QUIT
- +5 SET IBDSTR=$PIECE(IBLN,U,3)
- IF IBDSTR=2
- IF IBBRFN<1000
- SET IBDSTR=1.5
- +6 IF 'IBDSTR
- SET IBDSTR=9999
- +7 SET ^TMP($JOB,"IBCRBR",IBDSTR,$PIECE(IBLN,U,1),IBBRFN)=""
- End DoDot:1
- +8 QUIT