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

FBAUTHP.m

Go to the documentation of this file.
  1. FBAUTHP ;AISC/CMR - PRINT AUTH. BY AUTH # ;OCT 5, 1995
  1. ;;3.5;FEE BASIS;;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. W !! S DIR(0)="FO^1:50^K:X'?.N1""-"".N X",DIR("A")="Enter Authorization Number",DIR("?")="Enter the Authorization Number that appears on the 7079",DIR("?",1)="Enter numerics followed by a dash followed by numerics."
  1. D ^DIR K DIR I $D(DIRUT)!(Y']"") G END
  1. S DFN=+$P(Y,"-"),FBPROG=+$P(Y,"-",2)
  1. I 'DFN!('FBPROG) G ERR
  1. I '$D(^FBAAA(DFN,1,FBPROG)) G ERR
  1. S FBPROG="I FBI="_FBPROG,PI=""
  1. D ^FBAADEM,END G FBAUTHP
  1. END K FBPROG,DFN,FBAUT,FBAAOUT,PI,POP,X,Y,Z,DTOUT,DUOUT,DIRUT
  1. Q
  1. ERR W !,*7,"Invalid Authorization Number" D END G FBAUTHP