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

IBEBRH.m

Go to the documentation of this file.
  1. IBEBRH ;ALB/AAS - HELP FOR ENTER BILLING RATES PROCESSOR ;4-MAR-92
  1. ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. % S IBX="MAIN" D 1
  1. Q
  1. ;
  1. 1 ;
  1. W !!,"Select one of the displayed choices by number or name."
  1. W !,"You must select the type of rate to add/edit to proceed."
  1. Q
  1. ;
  1. 2 ; - help for 1 group of rates
  1. N I,J,IBP,IBPD,IBNOD
  1. I IBX="MAIN" D Q
  1. .W !!,"CHOOSE FROM:" F J=1:1 S TEXT=$P($T(@IBX+J^IBEBR),";;",2,99) Q:TEXT="" W !?4,TEXT
  1. F J=1:1 S IBP=$P($T(@IBX+J^IBEBR),";;",2,99),IBPD=$P(IBP,"^") Q:IBPD="" D 3
  1. Q
  1. 3 ; - help for 1 rate name
  1. N I,IBNOD
  1. I $D(%DT) W !!,"To edit an entry enter one of the following effective dates.",!
  1. 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
  1. . 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)
  1. . I $P(IBNOD,"^",6) W " + $",$J($P(IBNOD,"^",6),7,2)
  1. . W ?65,$S($P(IBNOD,"^",5):"INACTIVE",1:"ACTIVE")
  1. I $D(%DT) W !!,"Or enter a new effective date to add a new rate.",!
  1. Q