Routine: IBEBRH

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

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."

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

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.",!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBEBRH   1194     printed  Apr 09, 2024@21:09:55                                                                                                                                                                                                      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

IBEBRH.m