FBAAV3 ;AISC/GRR - CREATE & ELECTRONICALLY TRANSMIT TRANSACTIONS FOR TRAVEL PAYMENTS ;3/23/2012
;;3.5;FEE BASIS;**3,89,116,132,158**;JAN 30, 1995;Build 94
;;Per VA Directive 6402, this routine should not be modified.
DETT ; process a travel batch
S FBTXT=0
; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
;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
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
.S FBPICN=K_U_L
.S FBPICN=$$ORGICN^FBAAVR5(162.04,FBPICN)
.I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD^FBAAV0
.D GOT
D:FBTXT XMIT^FBAAV01 Q
GOT ; process a travel line item
N DFN,FBPNAMX
S FBTD=$$AUSDT($P(Y(0),U))
S FBAP=$$AUSAMT($P(Y(0),"^",3),8)
S DFN=K
Q:'DFN
Q:'$D(^DPT(DFN,0))
; Note: Prior to the following line Y(0) = 0 node of subfile #162.04
; After the line, Y(0) will = 0 node of file #2
S Y(0)=^DPT(DFN,0)
D PAT^FBAAUTL2
S FBPNAMX=$$HL7NAME^FBAAV4(DFN) ; formatted patient name
S FBSTR="T"_FBAASN_FBSSN_"T"_FBPNAMX_FBAP_FBAAON_FBTD_"0"_$E(PAD,1,8)
S FBSTR=FBSTR_$$PADZ^FBAAV01(FBPICN,30)_FBTD_"$"
D STORE^FBAAV01
K FBPICN
Q
;
AUSDT(FBDT) ;called to format date from VA FileMan internal to YYYYMMDD
; if input date is blank or invalid, eight spaces will be returned
;
N FBRET
S:FBDT FBRET=$$FMTHL7^XLFDT($P(FBDT,"."))
S:$G(FBRET)=""!($G(FBRET)<0) FBRET=" "
Q FBRET
;
AUSAMT(FBAMT,FBL,FBS) ; called to format signed dollar amount for Austin
; input
; FBAMT - dollar amount
; FBL - (optional) length of return sting
; FBS - (optional) =true(1) if return value could be negative (-)
; default is false (0)
; result
; string value, right justified, 0 padded, decimal point removed,
; with rightmost 2 numeric characters the cents
; if FBS true then rightmost character indicate the sign (' ' or '-')
; example with FBS false: 12.41 with length 8 would return '00001241'
; example with FBS true: 12.41 with length 9 would return '00001241 '
; example with FBS true: -12.41 with length 9 would return '00001241-'
;
N FBRET
;
; use absolute value
S FBRET=$S(FBAMT<0:-FBAMT,1:FBAMT)
;
; format with 2 decimals places
S FBRET=$FN(FBRET,"",2)
;
; remove the decimal point
S FBRET=$TR(FBRET,".","")
;
; add the suffix denoting the sign when applicable (when FBS true)
S FBRET=FBRET_$S('$G(FBS):"",FBAMT<0:"-",1:" ")
;
; right justify and 0 pad
S FBRET=$$RJ^XLFSTR(FBRET,$G(FBL),"0")
;
; return result
Q FBRET
;
AUSNUM(FBNUM,FBDEC,FBL,FBS) ; called to format signed/unsigned numeric for Austin
; input
; FBNUM - numeric
; FBDEC - number of decimal places
; FBL - (optional) length of return sting
; FBS - (optional) =true(1) if return value could be negative (-)
; default is false (0)
; result
; string value, right justified, 0 padded, decimal point removed,
; with rightmost FBDEC=5 numeric characters the decimal part
; if FBS true then rightmost character indicate the sign (' ' or '-')
; example with FBS false: 12.41 with length 12 would return '000001241000'
; example with FBS true: 12.41 with length 13 would return '000001241000 '
; example with FBS true: -12.41 with length 13 would return '000001241000-'
;
N FBRET
;
; use absolute value
S FBRET=$S(FBNUM<0:-FBNUM,1:FBNUM)
;
; format with 5 decimals places
S FBRET=$FN(FBRET,"",FBDEC)
;
; remove the decimal point
S FBRET=$TR(FBRET,".","")
;
; add the suffix denoting the sign when applicable (when FBS true)
S FBRET=FBRET_$S('$G(FBS):"",FBNUM<0:"-",1:" ")
;
; right justify and 0 pad
S FBRET=$$RJ^XLFSTR(FBRET,$G(FBL),"0")
;
; return result
Q FBRET
;FBAAV3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAV3 3932 printed Nov 22, 2024@17:07:08 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
DETT ; process a travel batch
+1 SET FBTXT=0
+2 ; HIPAA 5010 - line items that have 0.00 amount paid are now required to go to Central Fee
+3 ;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
+4 FOR K=0:0
SET K=$ORDER(^FBAAC("AD",J,K))
if K'>0
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AD",J,K,L))
if L'>0
QUIT
SET Y(0)=$GET(^FBAAC(K,3,L,0))
IF Y(0)]""
Begin DoDot:1
+5 SET FBPICN=K_U_L
+6 SET FBPICN=$$ORGICN^FBAAVR5(162.04,FBPICN)
+7 IF 'FBTXT
SET FBTXT=1
DO NEWMSG^FBAAV01
DO STORE^FBAAV01
DO UPD^FBAAV0
+8 DO GOT
End DoDot:1
+9 if FBTXT
DO XMIT^FBAAV01
QUIT
GOT ; process a travel line item
+1 NEW DFN,FBPNAMX
+2 SET FBTD=$$AUSDT($PIECE(Y(0),U))
+3 SET FBAP=$$AUSAMT($PIECE(Y(0),"^",3),8)
+4 SET DFN=K
+5 if 'DFN
QUIT
+6 if '$DATA(^DPT(DFN,0))
QUIT
+7 ; Note: Prior to the following line Y(0) = 0 node of subfile #162.04
+8 ; After the line, Y(0) will = 0 node of file #2
+9 SET Y(0)=^DPT(DFN,0)
+10 DO PAT^FBAAUTL2
+11 ; formatted patient name
SET FBPNAMX=$$HL7NAME^FBAAV4(DFN)
+12 SET FBSTR="T"_FBAASN_FBSSN_"T"_FBPNAMX_FBAP_FBAAON_FBTD_"0"_$EXTRACT(PAD,1,8)
+13 SET FBSTR=FBSTR_$$PADZ^FBAAV01(FBPICN,30)_FBTD_"$"
+14 DO STORE^FBAAV01
+15 KILL FBPICN
+16 QUIT
+17 ;
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
+2 ;
+3 NEW FBRET
+4 if FBDT
SET FBRET=$$FMTHL7^XLFDT($PIECE(FBDT,"."))
+5 if $GET(FBRET)=""!($GET(FBRET)<0)
SET FBRET=" "
+6 QUIT FBRET
+7 ;
AUSAMT(FBAMT,FBL,FBS) ; called to format signed dollar amount for Austin
+1 ; input
+2 ; FBAMT - dollar amount
+3 ; FBL - (optional) length of return sting
+4 ; FBS - (optional) =true(1) if return value could be negative (-)
+5 ; default is false (0)
+6 ; result
+7 ; string value, right justified, 0 padded, decimal point removed,
+8 ; with rightmost 2 numeric characters the cents
+9 ; if FBS true then rightmost character indicate the sign (' ' or '-')
+10 ; example with FBS false: 12.41 with length 8 would return '00001241'
+11 ; example with FBS true: 12.41 with length 9 would return '00001241 '
+12 ; example with FBS true: -12.41 with length 9 would return '00001241-'
+13 ;
+14 NEW FBRET
+15 ;
+16 ; use absolute value
+17 SET FBRET=$SELECT(FBAMT<0:-FBAMT,1:FBAMT)
+18 ;
+19 ; format with 2 decimals places
+20 SET FBRET=$FNUMBER(FBRET,"",2)
+21 ;
+22 ; remove the decimal point
+23 SET FBRET=$TRANSLATE(FBRET,".","")
+24 ;
+25 ; add the suffix denoting the sign when applicable (when FBS true)
+26 SET FBRET=FBRET_$SELECT('$GET(FBS):"",FBAMT<0:"-",1:" ")
+27 ;
+28 ; right justify and 0 pad
+29 SET FBRET=$$RJ^XLFSTR(FBRET,$GET(FBL),"0")
+30 ;
+31 ; return result
+32 QUIT FBRET
+33 ;
AUSNUM(FBNUM,FBDEC,FBL,FBS) ; called to format signed/unsigned numeric for Austin
+1 ; input
+2 ; FBNUM - numeric
+3 ; FBDEC - number of decimal places
+4 ; FBL - (optional) length of return sting
+5 ; FBS - (optional) =true(1) if return value could be negative (-)
+6 ; default is false (0)
+7 ; result
+8 ; string value, right justified, 0 padded, decimal point removed,
+9 ; with rightmost FBDEC=5 numeric characters the decimal part
+10 ; if FBS true then rightmost character indicate the sign (' ' or '-')
+11 ; example with FBS false: 12.41 with length 12 would return '000001241000'
+12 ; example with FBS true: 12.41 with length 13 would return '000001241000 '
+13 ; example with FBS true: -12.41 with length 13 would return '000001241000-'
+14 ;
+15 NEW FBRET
+16 ;
+17 ; use absolute value
+18 SET FBRET=$SELECT(FBNUM<0:-FBNUM,1:FBNUM)
+19 ;
+20 ; format with 5 decimals places
+21 SET FBRET=$FNUMBER(FBRET,"",FBDEC)
+22 ;
+23 ; remove the decimal point
+24 SET FBRET=$TRANSLATE(FBRET,".","")
+25 ;
+26 ; add the suffix denoting the sign when applicable (when FBS true)
+27 SET FBRET=FBRET_$SELECT('$GET(FBS):"",FBNUM<0:"-",1:" ")
+28 ;
+29 ; right justify and 0 pad
+30 SET FBRET=$$RJ^XLFSTR(FBRET,$GET(FBL),"0")
+31 ;
+32 ; return result
+33 QUIT FBRET
+34 ;FBAAV3
