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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAS79 880 printed Dec 13, 2024@01:56:34 Page 2
FBAAS79 ;AISC/GRR-PRINT SINGLE 7079 ;07OCT86
+1 ;;3.5;FEE BASIS;;JAN 30, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 if '$DATA(FBSITE(0))
DO SITEP^FBAAUTL
SET FBPROG=$SELECT($PIECE(FBSITE(1),"^",6)="":"I 1",1:"I $P(^(0),""^"",3)=2")
1 DO GETVET^FBAAUTL1
if 'DFN
GOTO Q
+1 DO GETAUTH^FBAAUTL1
if FTP']""
GOTO 1
+2 SET FBK=+FTP
EN1 ;ENTRY POINT FROM AUTHORIZATION OPTION (FBAAAUT)
+1 if '$DATA(^FBAAA(DFN,1,FBK,0))
QUIT
SET FBZZ(0)=^(0)
SET J=$PIECE(FBZZ(0),"^",13)
+2 SET J=$SELECT(J=1:$PIECE(FBZZ(0),"^"),J=2:$PIECE(FBZZ(0),"^"),J=3:$SELECT($DATA(^FBAAA(DFN,4)):$PIECE(^(4),"^",2),1:$PIECE(FBZZ(0),"^")),1:$PIECE(FBZZ(0),"^"))
KILL FBZZ
+3 DO OUTPUT
2 SET FBJ=DT
SET VAR="DFN^FBK^FBJ"
SET VAL=DFN_"^"_FBJ_"^"_FBK
SET PGM="START^FBAAS79"
SET IOP="Q"
DO ZIS^FBAAUTL
if FBPOP
GOTO Q
+1 ;
START DO SITEP^FBAAUTL
SET UL=""
SET $PIECE(UL,"-",120)="-"
SET FBPG=0
USE IO
DO GOT^FBAA79
+1 ;
Q DO END^FBAA79
DO CLOSE^FBAAUTL
QUIT
OUTPUT ;
+1 WRITE !!?8,"This report produces a 132 character output.",!
QUIT
