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

FBAAV3.m

Go to the documentation of this file.
  1. FBAAV3 ;AISC/GRR - CREATE & ELECTRONICALLY TRANSMIT TRANSACTIONS FOR TRAVEL PAYMENTS ;3/23/2012
  1. ;;3.5;FEE BASIS;**3,89,116,132,158**;JAN 30, 1995;Build 94
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. DETT ; process a travel batch
  1. S FBTXT=0
  1. ; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
  1. ;F K=0:0 S K=$O(^FBAAC("AD",J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AD",J,K,L)) Q:L'>0 S Y(0)=$G(^FBAAC(K,3,L,0)) I Y(0)]"",+$P(Y(0),U,3) D
  1. F K=0:0 S K=$O(^FBAAC("AD",J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AD",J,K,L)) Q:L'>0 S Y(0)=$G(^FBAAC(K,3,L,0)) I Y(0)]"" D
  1. .S FBPICN=K_U_L
  1. .S FBPICN=$$ORGICN^FBAAVR5(162.04,FBPICN)
  1. .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD^FBAAV0
  1. .D GOT
  1. D:FBTXT XMIT^FBAAV01 Q
  1. GOT ; process a travel line item
  1. N DFN,FBPNAMX
  1. S FBTD=$$AUSDT($P(Y(0),U))
  1. S FBAP=$$AUSAMT($P(Y(0),"^",3),8)
  1. S DFN=K
  1. Q:'DFN
  1. Q:'$D(^DPT(DFN,0))
  1. ; Note: Prior to the following line Y(0) = 0 node of subfile #162.04
  1. ; After the line, Y(0) will = 0 node of file #2
  1. S Y(0)=^DPT(DFN,0)
  1. D PAT^FBAAUTL2
  1. S FBPNAMX=$$HL7NAME^FBAAV4(DFN) ; formatted patient name
  1. S FBSTR="T"_FBAASN_FBSSN_"T"_FBPNAMX_FBAP_FBAAON_FBTD_"0"_$E(PAD,1,8)
  1. S FBSTR=FBSTR_$$PADZ^FBAAV01(FBPICN,30)_FBTD_"$"
  1. D STORE^FBAAV01
  1. K FBPICN
  1. Q
  1. ;
  1. AUSDT(FBDT) ;called to format date from VA FileMan internal to YYYYMMDD
  1. ; if input date is blank or invalid, eight spaces will be returned
  1. ;
  1. N FBRET
  1. S:FBDT FBRET=$$FMTHL7^XLFDT($P(FBDT,"."))
  1. S:$G(FBRET)=""!($G(FBRET)<0) FBRET=" "
  1. Q FBRET
  1. ;
  1. AUSAMT(FBAMT,FBL,FBS) ; called to format signed dollar amount for Austin
  1. ; input
  1. ; FBAMT - dollar amount
  1. ; FBL - (optional) length of return sting
  1. ; FBS - (optional) =true(1) if return value could be negative (-)
  1. ; default is false (0)
  1. ; result
  1. ; string value, right justified, 0 padded, decimal point removed,
  1. ; with rightmost 2 numeric characters the cents
  1. ; if FBS true then rightmost character indicate the sign (' ' or '-')
  1. ; example with FBS false: 12.41 with length 8 would return '00001241'
  1. ; example with FBS true: 12.41 with length 9 would return '00001241 '
  1. ; example with FBS true: -12.41 with length 9 would return '00001241-'
  1. ;
  1. N FBRET
  1. ;
  1. ; use absolute value
  1. S FBRET=$S(FBAMT<0:-FBAMT,1:FBAMT)
  1. ;
  1. ; format with 2 decimals places
  1. S FBRET=$FN(FBRET,"",2)
  1. ;
  1. ; remove the decimal point
  1. S FBRET=$TR(FBRET,".","")
  1. ;
  1. ; add the suffix denoting the sign when applicable (when FBS true)
  1. S FBRET=FBRET_$S('$G(FBS):"",FBAMT<0:"-",1:" ")
  1. ;
  1. ; right justify and 0 pad
  1. S FBRET=$$RJ^XLFSTR(FBRET,$G(FBL),"0")
  1. ;
  1. ; return result
  1. Q FBRET
  1. ;
  1. AUSNUM(FBNUM,FBDEC,FBL,FBS) ; called to format signed/unsigned numeric for Austin
  1. ; input
  1. ; FBNUM - numeric
  1. ; FBDEC - number of decimal places
  1. ; FBL - (optional) length of return sting
  1. ; FBS - (optional) =true(1) if return value could be negative (-)
  1. ; default is false (0)
  1. ; result
  1. ; string value, right justified, 0 padded, decimal point removed,
  1. ; with rightmost FBDEC=5 numeric characters the decimal part
  1. ; if FBS true then rightmost character indicate the sign (' ' or '-')
  1. ; example with FBS false: 12.41 with length 12 would return '000001241000'
  1. ; example with FBS true: 12.41 with length 13 would return '000001241000 '
  1. ; example with FBS true: -12.41 with length 13 would return '000001241000-'
  1. ;
  1. N FBRET
  1. ;
  1. ; use absolute value
  1. S FBRET=$S(FBNUM<0:-FBNUM,1:FBNUM)
  1. ;
  1. ; format with 5 decimals places
  1. S FBRET=$FN(FBRET,"",FBDEC)
  1. ;
  1. ; remove the decimal point
  1. S FBRET=$TR(FBRET,".","")
  1. ;
  1. ; add the suffix denoting the sign when applicable (when FBS true)
  1. S FBRET=FBRET_$S('$G(FBS):"",FBNUM<0:"-",1:" ")
  1. ;
  1. ; right justify and 0 pad
  1. S FBRET=$$RJ^XLFSTR(FBRET,$G(FBL),"0")
  1. ;
  1. ; return result
  1. Q FBRET
  1. ;FBAAV3