Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAETA

FBAAETA.m

Go to the documentation of this file.
  1. FBAAETA ;AISC/GRR,DMK/CMR - ENTER TRAVEL PAYMENT ONLY ;9/25/2014
  1. ;;3.5;FEE BASIS;**154**;JAN 30, 1995;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. RD ;set site parameters
  1. S:$G(FBAAPTC)']"" FBAAPTC="R"
  1. D SITE^FBAACO G END:$G(FBPOP)
  1. ;get veteran
  1. D GETVET^FBAAUTL1 I '$G(DFN) D END Q
  1. ;get authorization
  1. D GETAUTH^FBAAUTL1 G RD:'$G(FTP)
  1. ;
  1. I '$$UOKPAY^FBUTL9(DFN,FTP) D G RD
  1. . W !!,"You cannot process a payment associated with authorization ",DFN,"-",FTP
  1. . W !,"due to separation of duties."
  1. ;
  1. ;call to verify veteran address data
  1. D ^FBAACO0
  1. ;check for travel multiple dd reference
  1. S DA(1)=+$G(DFN)
  1. I '$D(^FBAAC(DA(1),3,0)) S ^(0)="^162.04DA^^"
  1. RD1 W !! S DIC="^FBAAC(DA(1),3,",DIC(0)="AEQLM",DLAYGO=162 D ^DIC K DLAYGO
  1. G END:X="^"!(X=""),RD1:Y<0 S DA=+Y,FBNEW=$P(Y,"^",3)
  1. S FBTRVDT=$P(Y,U,2)
  1. ;check if travel date within selected authorization if 'kill and reask
  1. I $G(FBAABDT),$G(FBAAEDT),(FBTRVDT<FBAABDT!(FBTRVDT>FBAAEDT)) D D KILL G RD1
  1. . W !!,*7,"Date of Travel is ",$S(FBTRVDT<FBAABDT:"prior to",1:"after")," authorization date.",!
  1. ;set travel payment
  1. 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
  1. G RD
  1. ;
  1. END K DIC,DIE,DR,X,Y,DA,C,D0,D1,DI,DIYS,Z,FBNEW,DLAYGO,FB1,FB2,FBTRVDT
  1. D Q^FBAACO
  1. Q
  1. KILL ;KILLS ENTRY IF USER UP-ARROWED DURING ENTRY
  1. W !!,*7,"Travel Payment entry not complete. Deleting entry..."
  1. S DIK="^FBAAC("_DA(1)_",3," D ^DIK Q