- 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 Feb 18, 2025@23:23:23 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