- FBAABS ;AISC/GRR - DISPLAY BATCH STATUS ;4/4/2012
- ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- BT K FBAANQ W !! S DIC="^FBAA(161.7,",DIC(0)="AEQM" D ^DIC G Q:X="^"!(X=""),BT:Y<0 S DA=+Y
- S VAR="DA",VAL=DA,PGM="START^FBAABS" D ZIS^FBAAUTL G Q:FBPOP S:IO=IO(0) FBAANQ=1
- START U IO W:$E(IOST,1,2)="C-" @IOF S DIC="^FBAA(161.7,",DIC(0)="AEQM",DR="0:1;ST" D EN^DIQ
- G:$D(FBAANQ) BT
- Q D CLOSE^FBAAUTL K DIC,DA,DR,X,Y,FBAANQ,A,D0,DL,DRX,PGM,S,VAL,VAR Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAABS 525 printed Mar 13, 2025@20:59:40 Page 2
- FBAABS ;AISC/GRR - DISPLAY BATCH STATUS ;4/4/2012
- +1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- BT KILL FBAANQ
- WRITE !!
- SET DIC="^FBAA(161.7,"
- SET DIC(0)="AEQM"
- DO ^DIC
- if X="^"!(X="")
- GOTO Q
- if Y<0
- GOTO BT
- SET DA=+Y
- +1 SET VAR="DA"
- SET VAL=DA
- SET PGM="START^FBAABS"
- DO ZIS^FBAAUTL
- if FBPOP
- GOTO Q
- if IO=IO(0)
- SET FBAANQ=1
- START USE IO
- if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- SET DIC="^FBAA(161.7,"
- SET DIC(0)="AEQM"
- SET DR="0:1;ST"
- DO EN^DIQ
- +1 if $DATA(FBAANQ)
- GOTO BT
- Q DO CLOSE^FBAAUTL
- KILL DIC,DA,DR,X,Y,FBAANQ,A,D0,DL,DRX,PGM,S,VAL,VAR
- QUIT