| 1 | PRCFARR0 ;ISC-SF/TKW-BUILD RECEIVING REPORT FOR ELECTRONIC TRANSMISSION TO AUSTIN ;2/1/95 12:34
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ; ENTRY POINT FOR AUTOMATIC TRANSMISSION
|
|---|
| 5 | S5 ;#5 ACCT.INFO-EST.SHIP,FOB,TOTAL AMT.(PARTIAL),TOTAL FMS AMT.,DATE RCVD.,DISCOUNT INFO,PRODUCT TYPE,LIQUIDATION CODE, FMS VENDOR ID & ALT. ADDRESS INDICATOR
|
|---|
| 6 | S Z(1)="" N FMSTOT,PRCTOT S FMSTOT=0,PRCTOT=0 ; Initialize FMS Total Amount
|
|---|
| 7 | I PRCFPR=1 S X=$P(PRCF0,"^",13) D FAMT S Z(1)=X,FMSTOT=FMSTOT+X,PRCTOT=PRCTOT+X
|
|---|
| 8 | S Z=$P($P(PRCF11,"^",13),"%")
|
|---|
| 9 | N MULT S MULT=1 I Z D
|
|---|
| 10 | . S X=$FN(Z,"",3),MULT=1-(X/100)
|
|---|
| 11 | . S X=$P(X,".",1)_$P(X,".",2)
|
|---|
| 12 | . S Z=X,Z=$S(($L(Z))<5:"0"_Z,1:Z)
|
|---|
| 13 | . Q
|
|---|
| 14 | ; values for 4th and 5th piece added in routine PRCFARR3
|
|---|
| 15 | S PRCFX="5^"_Z(1)_"^"_$P(PRCF1,"^",6)_"^^^"
|
|---|
| 16 | S PRCFX=PRCFX_$E(PRCF11,4,7)_$E(PRCF11,2,3)_"^"_Z_"^"
|
|---|
| 17 | S Z=$P($P(PRCF11,"^",13),"%",2)
|
|---|
| 18 | S PRCFX=PRCFX_$S(Z:+Z,1:"")_$S($P(Z,+Z,2)'="":"^P",1:"^")_"^^"
|
|---|
| 19 | N I F I=1,2 I "0"[$P(Z,"%",I) S $P(PRCFX,U,9)=""
|
|---|
| 20 | S PRCFX=PRCFX_$S(PRCFPR=1&($P(PRCF11,"^",9)="F"):"C",1:"P")_"^"
|
|---|
| 21 | PPT ;N PPT,I S PPT="",I=0
|
|---|
| 22 | ;N PPR F S I=$O(^PRC(442,PRCFA("PODA"),5,I)) Q:+I'=I S PPR=$G(^(I,0)) D
|
|---|
| 23 | ;. Q:PPR="" I $P(PPR,U,1)="NET",$P(PPR,U,5)]"" S PPT=$P(PPR,U,5)
|
|---|
| 24 | ;. I PPT="" S PPT=$P(PPR,U,5)
|
|---|
| 25 | ;. Q
|
|---|
| 26 | S $P(PRCFX,U,10)=$P($G(^PRC(442,PRCFA("PODA"),12)),U,15)
|
|---|
| 27 | VC N PRCFVP,PRCFV3 S PRCFVP=+PRCF1,PRCFV3=$G(^PRC(440,PRCFVP,3))
|
|---|
| 28 | N VC S VC=$P(PRCFV3,U,4) S:VC="" VC=$S($P($G(^PRC(440,PRCFVP,2)),U,2)]"":"MISCG",1:"MISCN")
|
|---|
| 29 | S $P(PRCFX,U,12)=VC
|
|---|
| 30 | I VC'?1"MISC".E S $P(PRCFX,U,13)=$P(PRCFV3,U,5)
|
|---|
| 31 | I VC?1"MISC".E S $P(PRCFX,U,14)=$E($P($G(^PRC(440,PRCFVP,0)),U,1),1,30)
|
|---|
| 32 | S $P(PRCFX,U,15)=$$FAP($P($G(^PRC(442,PRCFA("PODA"),11,PRCFPR,1)),U,17))
|
|---|
| 33 | S ^TMP("PRCFARR",$J,5,0)=PRCFX_U,$P(^(0),U,16)="",PRCFX=""
|
|---|
| 34 | G EN^PRCFARR1
|
|---|
| 35 | FAMT I 'X S X="" Q
|
|---|
| 36 | S X=$P(X,".")_$E($P(X,".",2)_"00",1,2) Q
|
|---|
| 37 | FAP(X) ;Return Fiscal Accounting Period When Passed FM Date
|
|---|
| 38 | Q:X="" X
|
|---|
| 39 | S X=$P("04^05^06^07^08^09^10^11^12^01^02^03",U,+$E(X,4,5))_(X\10000+$S($E(X,4,5)>9:1701,1:1700))
|
|---|
| 40 | Q X
|
|---|
