- 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 Feb 18, 2025@23:23 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