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

FBAAS79.m

Go to the documentation of this file.
  1. FBAAS79 ;AISC/GRR-PRINT SINGLE 7079 ;07OCT86
  1. ;;3.5;FEE BASIS;;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. D:'$D(FBSITE(0)) SITEP^FBAAUTL S FBPROG=$S($P(FBSITE(1),"^",6)="":"I 1",1:"I $P(^(0),""^"",3)=2")
  1. 1 D GETVET^FBAAUTL1 G Q:'DFN
  1. D GETAUTH^FBAAUTL1 G 1:FTP']""
  1. S FBK=+FTP
  1. EN1 ;ENTRY POINT FROM AUTHORIZATION OPTION (FBAAAUT)
  1. Q:'$D(^FBAAA(DFN,1,FBK,0)) S FBZZ(0)=^(0),J=$P(FBZZ(0),"^",13)
  1. S J=$S(J=1:$P(FBZZ(0),"^"),J=2:$P(FBZZ(0),"^"),J=3:$S($D(^FBAAA(DFN,4)):$P(^(4),"^",2),1:$P(FBZZ(0),"^")),1:$P(FBZZ(0),"^")) K FBZZ
  1. D OUTPUT
  1. 2 S FBJ=DT,VAR="DFN^FBK^FBJ",VAL=DFN_"^"_FBJ_"^"_FBK,PGM="START^FBAAS79",IOP="Q" D ZIS^FBAAUTL G Q:FBPOP
  1. ;
  1. START D SITEP^FBAAUTL S UL="",$P(UL,"-",120)="-",FBPG=0 U IO D GOT^FBAA79
  1. ;
  1. Q D END^FBAA79,CLOSE^FBAAUTL Q
  1. OUTPUT ;
  1. W !!?8,"This report produces a 132 character output.",! Q