IBEBRH ;ALB/AAS - HELP FOR ENTER BILLING RATES PROCESSOR ;4-MAR-92
;;2.0;INTEGRATED BILLING;**563**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
% S IBX="MAIN" D 1
Q
;
1 ;
W !!,"Select one of the displayed choices by number or name."
W !,"You must select the type of rate to add/edit to proceed."
Q
;
2 ; - help for 1 group of rates
N I,J,IBP,IBPD,IBNOD
I IBX="MAIN" D Q
.W !!,"CHOOSE FROM:" F J=1:1 S TEXT=$P($T(@IBX+J^IBEBR),";;",2,99) Q:TEXT="" W !?4,TEXT
F J=1:1 S IBP=$P($T(@IBX+J^IBEBR),";;",2,99),IBPD=$P(IBP,"^") Q:IBPD="" D 3
Q
3 ; - help for 1 rate name
N I,IBNOD
I $D(%DT) W !!,"To edit an entry enter one of the following effective dates.",!
S I="" F S I=$O(^IBE(350.2,"B",IBPD,I)) Q:'I S IBNOD=$G(^IBE(350.2,I,0)) I IBNOD'="" D
. W !?4,$$DAT2^IBOUTL($P(IBNOD,"^",2)),?20,$E($S($P(IBP,"^",5)'="":$P(IBP,"^",5),1:$P(IBP,"^")),1,20),?42,"$",$J($P(IBNOD,"^",4),7,2)
. I $P(IBNOD,"^",6) W " + $",$J($P(IBNOD,"^",6),7,2)
. I $P(IBNOD,"^",7) W ?62,"TIER ",$P(IBNOD,"^",7)
. W ?70,$S($P(IBNOD,"^",5):"INACTIVE",1:"ACTIVE")
I $D(%DT) W !!,"Or enter a new effective date to add a new rate.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEBRH 1194 printed Nov 22, 2024@17:31:12 Page 2
IBEBRH ;ALB/AAS - HELP FOR ENTER BILLING RATES PROCESSOR ;4-MAR-92
+1 ;;2.0;INTEGRATED BILLING;**563**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% SET IBX="MAIN"
DO 1
+1 QUIT
+2 ;
1 ;
+1 WRITE !!,"Select one of the displayed choices by number or name."
+2 WRITE !,"You must select the type of rate to add/edit to proceed."
+3 QUIT
+4 ;
2 ; - help for 1 group of rates
+1 NEW I,J,IBP,IBPD,IBNOD
+2 IF IBX="MAIN"
Begin DoDot:1
+3 WRITE !!,"CHOOSE FROM:"
FOR J=1:1
SET TEXT=$PIECE($TEXT(@IBX+J^IBEBR),";;",2,99)
if TEXT=""
QUIT
WRITE !?4,TEXT
End DoDot:1
QUIT
+4 FOR J=1:1
SET IBP=$PIECE($TEXT(@IBX+J^IBEBR),";;",2,99)
SET IBPD=$PIECE(IBP,"^")
if IBPD=""
QUIT
DO 3
+5 QUIT
3 ; - help for 1 rate name
+1 NEW I,IBNOD
+2 IF $DATA(%DT)
WRITE !!,"To edit an entry enter one of the following effective dates.",!
+3 SET I=""
FOR
SET I=$ORDER(^IBE(350.2,"B",IBPD,I))
if 'I
QUIT
SET IBNOD=$GET(^IBE(350.2,I,0))
IF IBNOD'=""
Begin DoDot:1
+4 WRITE !?4,$$DAT2^IBOUTL($PIECE(IBNOD,"^",2)),?20,$EXTRACT($SELECT($PIECE(IBP,"^",5)'="":$PIECE(IBP,"^",5),1:$PIECE(IBP,"^")),1,20),?42,"$",$JUSTIFY($PIECE(IBNOD,"^",4),7,2)
+5 IF $PIECE(IBNOD,"^",6)
WRITE " + $",$JUSTIFY($PIECE(IBNOD,"^",6),7,2)
+6 IF $PIECE(IBNOD,"^",7)
WRITE ?62,"TIER ",$PIECE(IBNOD,"^",7)
+7 WRITE ?70,$SELECT($PIECE(IBNOD,"^",5):"INACTIVE",1:"ACTIVE")
End DoDot:1
+8 IF $DATA(%DT)
WRITE !!,"Or enter a new effective date to add a new rate.",!
+9 QUIT
