FBAAPIN1.m

FBAAPIN1 ;AISC/GRR-INVOICE DISPLAY CONTINUED ;04APR90

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

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

 K ^UTILITY($J,"W") S DIWL=3,DIWF="WC79"

 F FBRR=0:0 S FBRR=$O(@(FBFILE_FBRR_")")) Q:FBRR'>0  S FBXX=^(FBRR,0),X=FBXX D ^DIWP I ($Y+5)>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT  D HED^FBAAPIN

 Q:FBAAOUT

 D ^DIWW:$D(FBXX) K FBXX

 Q

HELP I X=" " W !,*7,"Answer must be numeric" Q

 W @IOF S DIC="^FBAAC(",DIC(0)="",D="C",DZ="??" D DQ^DICQ

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAPIN1   518     printed  Apr 09, 2024@21:04:30                                                                                                                                                                                                     Page 2

FBAAPIN1  ;AISC/GRR-INVOICE DISPLAY CONTINUED ;04APR90

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

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

 +3        KILL ^UTILITY($JOB,"W")

           SET DIWL=3

           SET DIWF="WC79"

 +4        FOR FBRR=0:0

               SET FBRR=$ORDER(@(FBFILE_FBRR_")"))

               if FBRR'>0

                   QUIT 

               SET FBXX=^(FBRR,0)

               SET X=FBXX

               DO ^DIWP

               IF ($Y+5)>IOSL

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   if 'Y

                       SET FBAAOUT=1

                   if FBAAOUT

                       QUIT 

                   DO HED^FBAAPIN

 +5        if FBAAOUT

               QUIT 

 +6        if $DATA(FBXX)

               DO ^DIWW

           KILL FBXX

 +7        QUIT 

HELP       IF X=" "

               WRITE !,*7,"Answer must be numeric"

               QUIT 

 +1        WRITE @IOF

           SET DIC="^FBAAC("

           SET DIC(0)=""

           SET D="C"

           SET DZ="??"

           DO DQ^DICQ

 +2        QUIT