| 1 | FBAAETA ;AISC/GRR,DMK/CMR-ENTER TRAVEL PAYMENT ONLY ;05JAN87
|
|---|
| 2 | ;;3.5;FEE BASIS;;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | RD ;set site parameters
|
|---|
| 5 | S:$G(FBAAPTC)']"" FBAAPTC="R"
|
|---|
| 6 | D SITE^FBAACO G END:$G(FBPOP)
|
|---|
| 7 | ;get veteran
|
|---|
| 8 | D GETVET^FBAAUTL1 I '$G(DFN) D END Q
|
|---|
| 9 | ;get authorization
|
|---|
| 10 | D GETAUTH^FBAAUTL1 G RD:'$G(FTP)
|
|---|
| 11 | ;call to verify veteran address data
|
|---|
| 12 | D ^FBAACO0
|
|---|
| 13 | ;if site parameter set to 'yes' allow edit of authorization remarks
|
|---|
| 14 | D ^FBAAEAR:$P(FBSITE(1),U,4)="Y"
|
|---|
| 15 | ;check for travel multiple dd reference
|
|---|
| 16 | S DA(1)=+$G(DFN)
|
|---|
| 17 | I '$D(^FBAAC(DA(1),3,0)) S ^(0)="^162.04DA^^"
|
|---|
| 18 | RD1 W !! S DIC="^FBAAC(DA(1),3,",DIC(0)="AEQLM",DLAYGO=162 D ^DIC K DLAYGO
|
|---|
| 19 | G END:X="^"!(X=""),RD1:Y<0 S DA=+Y,FBNEW=$P(Y,"^",3)
|
|---|
| 20 | S FBTRVDT=$P(Y,U,2)
|
|---|
| 21 | ;check if travel date within selected authorization if 'kill and reask
|
|---|
| 22 | I $G(FBAABDT),$G(FBAAEDT),(FBTRVDT<FBAABDT!(FBTRVDT>FBAAEDT)) D D KILL G RD1
|
|---|
| 23 | . W !!,*7,"Date of Travel is ",$S(FBTRVDT<FBAABDT:"prior to",1:"after")," authorization date.",!
|
|---|
| 24 | ;set travel payment
|
|---|
| 25 | S DIE=DIC,DR=".01;1;2;3.5///^S X=FBAAPTC" D ^DIE I $G(FBNEW)&($D(Y)'=0) D KILL,END
|
|---|
| 26 | G RD
|
|---|
| 27 | ;
|
|---|
| 28 | END K DIC,DIE,DR,X,Y,DA,C,D0,D1,DI,DIYS,Z,FBNEW,DLAYGO,FB1,FB2,FBTRVDT
|
|---|
| 29 | D Q^FBAACO
|
|---|
| 30 | Q
|
|---|
| 31 | KILL ;KILLS ENTRY IF USER UP-ARROWED DURING ENTRY
|
|---|
| 32 | W !!,*7,"Travel Payment entry not complete. Deleting entry..."
|
|---|
| 33 | S DIK="^FBAAC("_DA(1)_",3," D ^DIK Q
|
|---|
