FBAAPII.m

FBAAPII ;AISC/GRR-PHARMACY INVOICE DISPLAY ;03JUN86

 ;;3.5;FEE BASIS;;JAN 30, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

RD W !! S DIC="^FBAA(162.1,",DIC(0)="AEQM" D ^DIC G Q:X=""!(X="^"),RD:Y<0 S DA=+Y

 S VAR="DA",VAL=DA,PGM="START^FBAAPII" D ZIS^FBAAUTL G:FBPOP Q S:IO=IO(0) FBAANQ=1

START U IO W:$E(IOST,1,2)["C-" @IOF S DIC="^FBAA(162.1,",DIC(0)="AEQM",DR="0;RX" D EN^DIQ

Q D CLOSE^FBAAUTL K DIC,DIE,DR,DA,X,Y,A,D0,DQ,DL,DRX,DX,PGM,S,VAL,VAR

 I $D(FBAANQ) K FBAANQ G RD

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAPII   517     printed  Apr 09, 2024@21:00:39                                                                                                                                                                                                      Page 2

FBAAPII   ;AISC/GRR-PHARMACY INVOICE DISPLAY ;03JUN86

 +1       ;;3.5;FEE BASIS;;JAN 30, 1995

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

RD         WRITE !!

           SET DIC="^FBAA(162.1,"

           SET DIC(0)="AEQM"

           DO ^DIC

           if X=""!(X="^")

               GOTO Q

           if Y<0

               GOTO RD

           SET DA=+Y

 +1        SET VAR="DA"

           SET VAL=DA

           SET PGM="START^FBAAPII"

           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(162.1,"

           SET DIC(0)="AEQM"

           SET DR="0;RX"

           DO EN^DIQ

Q          DO CLOSE^FBAAUTL

           KILL DIC,DIE,DR,DA,X,Y,A,D0,DQ,DL,DRX,DX,PGM,S,VAL,VAR

 +1        IF $DATA(FBAANQ)

               KILL FBAANQ

               GOTO RD

 +2        QUIT