source: FOIAVistA/trunk/r/FEE_BASIS-FB/FBAAETA.m@ 1751

Last change on this file since 1751 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.3 KB
Line 
1FBAAETA ;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.
4RD ;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^^"
18RD1 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 ;
28END K DIC,DIE,DR,X,Y,DA,C,D0,D1,DI,DIYS,Z,FBNEW,DLAYGO,FB1,FB2,FBTRVDT
29 D Q^FBAACO
30 Q
31KILL ;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
Note: See TracBrowser for help on using the repository browser.