FBAAETA.m

FBAAETA ;AISC/GRR,DMK/CMR - ENTER TRAVEL PAYMENT ONLY ;9/25/2014

 ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12

 ;;Per VA Directive 6402, this routine should not be modified.

RD ;set site parameters

 S:$G(FBAAPTC)']"" FBAAPTC="R"

 D SITE^FBAACO G END:$G(FBPOP)

 ;get veteran

 D GETVET^FBAAUTL1 I '$G(DFN) D END Q

 ;get authorization

 D GETAUTH^FBAAUTL1 G RD:'$G(FTP)

 ;

 I '$$UOKPAY^FBUTL9(DFN,FTP) D  G RD

 . W !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP

 . W !,"due to separation of duties."

 ;

 ;call to verify veteran address data

 D ^FBAACO0

 ;check for travel multiple dd reference

 S DA(1)=+$G(DFN)

 I '$D(^FBAAC(DA(1),3,0)) S ^(0)="^162.04DA^^"

RD1 W !! S DIC="^FBAAC(DA(1),3,",DIC(0)="AEQLM",DLAYGO=162 D ^DIC K DLAYGO

 G END:X="^"!(X=""),RD1:Y<0 S DA=+Y,FBNEW=$P(Y,"^",3)

 S FBTRVDT=$P(Y,U,2)

 ;check if travel date within selected authorization if 'kill and reask

 I $G(FBAABDT),$G(FBAAEDT),(FBTRVDT<FBAABDT!(FBTRVDT>FBAAEDT)) D  D KILL G RD1

 . W !!,*7,"Date of Travel is ",$S(FBTRVDT<FBAABDT:"prior to",1:"after")," authorization date.",!

 ;set travel payment

 S DIE=DIC,DR=".01;1;2;3.5///^S X=FBAAPTC;15///^S X=FTP" D ^DIE I $G(FBNEW)&($D(Y)'=0) D KILL,END

 G RD

 ;

END K DIC,DIE,DR,X,Y,DA,C,D0,D1,DI,DIYS,Z,FBNEW,DLAYGO,FB1,FB2,FBTRVDT

 D Q^FBAACO

 Q

KILL ;KILLS ENTRY IF USER UP-ARROWED DURING ENTRY

 W !!,*7,"Travel Payment entry not complete.   Deleting entry..."

 S DIK="^FBAAC("_DA(1)_",3," D ^DIK Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAETA   1489     printed  Apr 09, 2024@21:02:49                                                                                                                                                                                                     Page 2

FBAAETA   ;AISC/GRR,DMK/CMR - ENTER TRAVEL PAYMENT ONLY ;9/25/2014

 +1       ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12

 +2       ;;Per VA Directive 6402, this routine should not be modified.

RD        ;set site parameters

 +1        if $GET(FBAAPTC)']""

               SET FBAAPTC="R"

 +2        DO SITE^FBAACO

           if $GET(FBPOP)

               GOTO END

 +3       ;get veteran

 +4        DO GETVET^FBAAUTL1

           IF '$GET(DFN)

               DO END

               QUIT 

 +5       ;get authorization

 +6        DO GETAUTH^FBAAUTL1

           if '$GET(FTP)

               GOTO RD

 +7       ;

 +8        IF '$$UOKPAY^FBUTL9(DFN,FTP)

               Begin DoDot:1

 +9                WRITE !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP

 +10               WRITE !,"due to separation of duties."

               End DoDot:1

               GOTO RD

 +11      ;

 +12      ;call to verify veteran address data

 +13       DO ^FBAACO0

 +14      ;check for travel multiple dd reference

 +15       SET DA(1)=+$GET(DFN)

 +16       IF '$DATA(^FBAAC(DA(1),3,0))

               SET ^(0)="^162.04DA^^"

RD1        WRITE !!

           SET DIC="^FBAAC(DA(1),3,"

           SET DIC(0)="AEQLM"

           SET DLAYGO=162

           DO ^DIC

           KILL DLAYGO

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

               GOTO END

           if Y<0

               GOTO RD1

           SET DA=+Y

           SET FBNEW=$PIECE(Y,"^",3)

 +2        SET FBTRVDT=$PIECE(Y,U,2)

 +3       ;check if travel date within selected authorization if 'kill and reask

 +4        IF $GET(FBAABDT)

               IF $GET(FBAAEDT)

                   IF (FBTRVDT<FBAABDT!(FBTRVDT>FBAAEDT))

                       Begin DoDot:1

 +5                        WRITE !!,*7,"Date of Travel is ",$SELECT(FBTRVDT<FBAABDT:"prior to",1:"after")," authorization date.",!

                       End DoDot:1

                       DO KILL

                       GOTO RD1

 +6       ;set travel payment

 +7        SET DIE=DIC

           SET DR=".01;1;2;3.5///^S X=FBAAPTC;15///^S X=FTP"

           DO ^DIE

           IF $GET(FBNEW)&($DATA(Y)'=0)

               DO KILL

               DO END

 +8        GOTO RD

 +9       ;

END        KILL DIC,DIE,DR,X,Y,DA,C,D0,D1,DI,DIYS,Z,FBNEW,DLAYGO,FB1,FB2,FBTRVDT

 +1        DO Q^FBAACO

 +2        QUIT 

KILL      ;KILLS ENTRY IF USER UP-ARROWED DURING ENTRY

 +1        WRITE !!,*7,"Travel Payment entry not complete.   Deleting entry..."

 +2        SET DIK="^FBAAC("_DA(1)_",3,"

           DO ^DIK

           QUIT