| 1 | FBAAV2 ;AISC/GRR-ELECTRONICALLY TRANSMIT PHARMACY PAYMENTS ;11 Apr 2006 2:52 PM
|
|---|
| 2 | ;;3.5;FEE BASIS;**3,89,98**;JAN 30, 1995;Build 54
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DETP ; ENTRY FROM FBAAV0
|
|---|
| 5 | S FBTXT=0
|
|---|
| 6 | D CKB5V^FBAAV01 I $G(FBERR) K FBERR Q
|
|---|
| 7 | F K=0:0 S K=$O(^FBAA(162.1,"AE",J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAA(162.1,"AE",J,K,L)) Q:L'>0 S Y(0)=$G(^FBAA(162.1,K,"RX",L,0)),Y(2)=$G(^(2)),Y=$G(^FBAA(162.1,K,0)) I Y(0)]"",Y]"",+$P(Y(0),U,16) D
|
|---|
| 8 | .N FBPICN,FBY
|
|---|
| 9 | .S FBPICN=K_U_L
|
|---|
| 10 | .S FBY=$S($P(Y,U,12):$P(Y,U,12),1:$P(Y,U,2))_U_+$P(Y(2),U,9)
|
|---|
| 11 | .I 'FBTXT S FBTXT=1 D NEWMSG^FBAAV01,STORE^FBAAV01,UPD^FBAAV0
|
|---|
| 12 | .D GOTP
|
|---|
| 13 | D:FBTXT XMIT^FBAAV01
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | GOTP ; process a B5 line item
|
|---|
| 17 | N DFN,FBADJ,FBADJA1,FBADJA2,FBADJR1,FBADJR2,FBIENS,FBPNAMX,FBVY0,FBX,FBNPI
|
|---|
| 18 | ;
|
|---|
| 19 | S FBIENS=$P(FBPICN,U,2)_","_$P(FBPICN,U,1)_","
|
|---|
| 20 | S FBPAYT=$P(Y(0),"^",20),FBPAYT=$S(FBPAYT]"":FBPAYT,1:"V")
|
|---|
| 21 | S FBINVN=$P(Y,"^"),FBINVN=$E("000000000",$L(FBINVN)+1,9)_FBINVN
|
|---|
| 22 | S FBDIN=$$AUSDT^FBAAV3($P(Y,"^",2))
|
|---|
| 23 | ;
|
|---|
| 24 | S FBVFN=$P(Y,"^",4)
|
|---|
| 25 | S FBNPI=$$EN^FBNPILK(FBVFN)
|
|---|
| 26 | S FBVY0=$G(^FBAAV(FBVFN,0)) ; vendor 0 node
|
|---|
| 27 | S FBVID=$P(FBVY0,U,2),FBVID=$E(FBVID,1,9)_$E(PAD,$L(FBVID)+1,9)
|
|---|
| 28 | S FBCSN=$S($P(FBVY0,U,2)]"":$P(FBVY0,U,10),1:"")
|
|---|
| 29 | S FBCSN=$E("0000",$L(FBCSN)+1,4)_FBCSN
|
|---|
| 30 | I FBPAYT="R" S FBVID=$E(PAD,1,9),FBCSN=$E(PAD,1,4)
|
|---|
| 31 | K FBVY0
|
|---|
| 32 | ;
|
|---|
| 33 | S FBRX=$P(Y(0),"^",1),FBRX=$E("00000000",$L(FBRX)+1,8)_FBRX
|
|---|
| 34 | I '$L($G(FBAASN)) D STATION^FBAAUTL
|
|---|
| 35 | S FBPSA=$$PSA^FBAAV5(+$P(Y(2),U,5),+FBAASN) I $L(+FBPSA)'=3 S FBPSA=999
|
|---|
| 36 | S FBTD=$$AUSDT^FBAAV3($P(Y(0),"^",3))
|
|---|
| 37 | S FBSUSP=$P(Y(0),"^",8),FBSUSP=$S(FBSUSP="":" ",$D(^FBAA(161.27,+FBSUSP,0)):$P(^(0),"^"),1:" ")
|
|---|
| 38 | S FBAC=$$AUSAMT^FBAAV3($P(Y(0),"^",4),8)
|
|---|
| 39 | S FBAP=$$AUSAMT^FBAAV3($P(Y(0),"^",16),8)
|
|---|
| 40 | I FBAC=FBAP S FBAP=" "
|
|---|
| 41 | S DFN=$P(Y(0),"^",5)
|
|---|
| 42 | Q:'DFN
|
|---|
| 43 | Q:'$D(^DPT(DFN,0))
|
|---|
| 44 | ; Note: Prior to the following line Y(0) = the 0 node of subfile 161.11
|
|---|
| 45 | ; After the line Y(0) will be the 0 node of file #2
|
|---|
| 46 | S VAPA("P")="",Y(0)=^DPT(DFN,0) D PAT^FBAAUTL2,ADD^VADPT
|
|---|
| 47 | S FBPNAMX=$$HL7NAME^FBAAV4(DFN)
|
|---|
| 48 | S FBST=$S($P(VAPA(5),"^")="":" ",$D(^DIC(5,$P(VAPA(5),"^"),0)):$P(^(0),"^",2),1:" ")
|
|---|
| 49 | S:$L(FBST)'=2 FBST=$E(PAD,$L(FBST)+1,2)_FBST
|
|---|
| 50 | S FBCTY=$S($P(VAPA(7),"^")="":" ",FBST=" ":" ",$D(^DIC(5,$P(VAPA(5),"^"),1,$P(VAPA(7),"^"),0)):$P(^(0),"^",3),1:" ")
|
|---|
| 51 | I $L(FBCTY)'=3 S FBCTY=$E("000",$L(FBCTY)+1,3)_FBCTY
|
|---|
| 52 | S FBZIP=$S('+$G(VAPA(11)):VAPA(6),+VAPA(11):$P(VAPA(11),U),1:VAPA(6)),FBZIP=$TR(FBZIP,"-","")_$E("000000000",$L(FBZIP)+1,9)
|
|---|
| 53 | ;
|
|---|
| 54 | ; get and format adjustment reason codes and amounts (if any)
|
|---|
| 55 | D LOADADJ^FBRXFA(FBIENS,.FBADJ)
|
|---|
| 56 | S FBX=$$ADJL^FBUTL2(.FBADJ)
|
|---|
| 57 | S FBADJR1=$$RJ^XLFSTR($P(FBX,U,1),5," ")
|
|---|
| 58 | S FBADJA1=$$AUSAMT^FBAAV3($P(FBX,U,3),9,1)
|
|---|
| 59 | S FBADJR2=$$RJ^XLFSTR($P(FBX,U,4),5," ")
|
|---|
| 60 | S FBADJA2=$$AUSAMT^FBAAV3($P(FBX,U,6),9,1)
|
|---|
| 61 | K FBADJ,FBX
|
|---|
| 62 | ;
|
|---|
| 63 | S FBSTR=5_FBAASN_FBSSN_FBPAYT_FBPNAMX_FBVID_FBCSN_FBAC_FBAP_FBAAON_FBSUSP_FBTD_FBRX_FBDIN_FBINVN_FBST_FBCTY_FBZIP_$E(FBPSA,1,3)
|
|---|
| 64 | S FBSTR=FBSTR_$P(FBY,U,2)_$E(PAD,1,8)_$$PADZ^FBAAV01(FBPICN,30)_$$AUSDT^FBAAV3(+FBY)
|
|---|
| 65 | S FBSTR=FBSTR_FBADJR1_FBADJR2_FBADJA1_FBADJA2_FBNPI_"$"
|
|---|
| 66 | D STORE^FBAAV01
|
|---|
| 67 | Q
|
|---|
