FBAUTHP.m

FBAUTHP ;AISC/CMR - PRINT AUTH. BY AUTH # ;OCT 5, 1995

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

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

 W !! S DIR(0)="FO^1:50^K:X'?.N1""-"".N X",DIR("A")="Enter Authorization Number",DIR("?")="Enter the Authorization Number that appears on the 7079",DIR("?",1)="Enter numerics followed by a dash followed by numerics."

 D ^DIR K DIR I $D(DIRUT)!(Y']"") G END

 S DFN=+$P(Y,"-"),FBPROG=+$P(Y,"-",2)

 I 'DFN!('FBPROG) G ERR

 I '$D(^FBAAA(DFN,1,FBPROG)) G ERR

 S FBPROG="I FBI="_FBPROG,PI=""

 D ^FBAADEM,END G FBAUTHP

END K FBPROG,DFN,FBAUT,FBAAOUT,PI,POP,X,Y,Z,DTOUT,DUOUT,DIRUT

 Q

ERR W !,*7,"Invalid Authorization Number" D END G FBAUTHP

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAUTHP   703     printed  Apr 09, 2024@21:02:02                                                                                                                                                                                                      Page 2

FBAUTHP   ;AISC/CMR - PRINT AUTH. BY AUTH # ;OCT 5, 1995

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

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

 +3        WRITE !!

           SET DIR(0)="FO^1:50^K:X'?.N1""-"".N X"

           SET DIR("A")="Enter Authorization Number"

           SET DIR("?")="Enter the Authorization Number that appears on the 7079"

           SET DIR("?",1)="Enter numerics followed by a dash followed by numerics."

 +4        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!(Y']"")

               GOTO END

 +5        SET DFN=+$PIECE(Y,"-")

           SET FBPROG=+$PIECE(Y,"-",2)

 +6        IF 'DFN!('FBPROG)

               GOTO ERR

 +7        IF '$DATA(^FBAAA(DFN,1,FBPROG))

               GOTO ERR

 +8        SET FBPROG="I FBI="_FBPROG

           SET PI=""

 +9        DO ^FBAADEM

           DO END

           GOTO FBAUTHP

END        KILL FBPROG,DFN,FBAUT,FBAAOUT,PI,POP,X,Y,Z,DTOUT,DUOUT,DIRUT

 +1        QUIT 

ERR        WRITE !,*7,"Invalid Authorization Number"

           DO END

           GOTO FBAUTHP