| 1 | FBAAV3 ;AISC/GRR-CREATE & ELECTRONICALLY TRANSMIT TRANSACTIONS FOR TRAVEL PAYMENTS ;2/8/2005
|
|---|
| 2 | ;;3.5;FEE BASIS;**3,89**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DETT ; process a travel batch
|
|---|
| 5 | S FBTXT=0
|
|---|
| 6 | 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
|
|---|
| 7 | .S FBPICN=K_U_L
|
|---|
| 8 | .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD^FBAAV0
|
|---|
| 9 | .D GOT
|
|---|
| 10 | D:FBTXT XMIT^FBAAV01 Q
|
|---|
| 11 | GOT ; process a travel line item
|
|---|
| 12 | N DFN,FBPNAMX
|
|---|
| 13 | S FBTD=$$AUSDT($P(Y(0),U))
|
|---|
| 14 | S FBAP=$$AUSAMT($P(Y(0),"^",3),8)
|
|---|
| 15 | S DFN=K
|
|---|
| 16 | Q:'DFN
|
|---|
| 17 | Q:'$D(^DPT(DFN,0))
|
|---|
| 18 | ; Note: Prior to the following line Y(0) = 0 node of subfile #162.04
|
|---|
| 19 | ; After the line, Y(0) will = 0 node of file #2
|
|---|
| 20 | S Y(0)=^DPT(DFN,0)
|
|---|
| 21 | D PAT^FBAAUTL2
|
|---|
| 22 | S FBPNAMX=$$HL7NAME^FBAAV4(DFN) ; formatted patient name
|
|---|
| 23 | S FBSTR="T"_FBAASN_FBSSN_"T"_FBPNAMX_FBAP_FBAAON_FBTD_"0"_$E(PAD,1,8)
|
|---|
| 24 | S FBSTR=FBSTR_$$PADZ^FBAAV01(FBPICN,30)_FBTD_"$"
|
|---|
| 25 | D STORE^FBAAV01
|
|---|
| 26 | K FBPICN
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | AUSDT(FBDT) ;called to format date from VA FileMan internal to YYYYMMDD
|
|---|
| 30 | ; if input date is blank or invalid, eight spaces will be returned
|
|---|
| 31 | ;
|
|---|
| 32 | N FBRET
|
|---|
| 33 | S:FBDT FBRET=$$FMTHL7^XLFDT($P(FBDT,"."))
|
|---|
| 34 | S:$G(FBRET)=""!($G(FBRET)<0) FBRET=" "
|
|---|
| 35 | Q FBRET
|
|---|
| 36 | ;
|
|---|
| 37 | AUSAMT(FBAMT,FBL,FBS) ; called to format signed dollar amount for Austin
|
|---|
| 38 | ; input
|
|---|
| 39 | ; FBAMT - dollar amount
|
|---|
| 40 | ; FBL - (optional) length of return sting
|
|---|
| 41 | ; FBS - (optional) =true(1) if return value could be negative (-)
|
|---|
| 42 | ; default is false (0)
|
|---|
| 43 | ; result
|
|---|
| 44 | ; string value, right justified, 0 padded, decimal point removed,
|
|---|
| 45 | ; with rightmost 2 numeric characters the cents
|
|---|
| 46 | ; if FBS true then rightmost character indicate the sign (' ' or '-')
|
|---|
| 47 | ; example with FBS false: 12.41 with length 8 would return '00001241'
|
|---|
| 48 | ; example with FBS true: 12.41 with length 9 would return '00001241 '
|
|---|
| 49 | ; example with FBS true: -12.41 with length 9 would return '00001241-'
|
|---|
| 50 | ;
|
|---|
| 51 | N FBRET
|
|---|
| 52 | ;
|
|---|
| 53 | ; use absolute value
|
|---|
| 54 | S FBRET=$S(FBAMT<0:-FBAMT,1:FBAMT)
|
|---|
| 55 | ;
|
|---|
| 56 | ; format with 2 decimals places
|
|---|
| 57 | S FBRET=$FN(FBRET,"",2)
|
|---|
| 58 | ;
|
|---|
| 59 | ; remove the decimal point
|
|---|
| 60 | S FBRET=$TR(FBRET,".","")
|
|---|
| 61 | ;
|
|---|
| 62 | ; add the suffix denoting the sign when applicable (when FBS true)
|
|---|
| 63 | S FBRET=FBRET_$S('$G(FBS):"",FBAMT<0:"-",1:" ")
|
|---|
| 64 | ;
|
|---|
| 65 | ; right justify and 0 pad
|
|---|
| 66 | S FBRET=$$RJ^XLFSTR(FBRET,$G(FBL),"0")
|
|---|
| 67 | ;
|
|---|
| 68 | ; return result
|
|---|
| 69 | Q FBRET
|
|---|
| 70 | ;
|
|---|
| 71 | ;FBAAV3
|
|---|
