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