41 lines
2.0 KiB
Mathematica
41 lines
2.0 KiB
Mathematica
PRCFARR0 ;ISC-SF/TKW-BUILD RECEIVING REPORT FOR ELECTRONIC TRANSMISSION TO AUSTIN ;2/1/95 12:34
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
EN ; ENTRY POINT FOR AUTOMATIC TRANSMISSION
|
|
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
|
|
S Z(1)="" N FMSTOT,PRCTOT S FMSTOT=0,PRCTOT=0 ; Initialize FMS Total Amount
|
|
I PRCFPR=1 S X=$P(PRCF0,"^",13) D FAMT S Z(1)=X,FMSTOT=FMSTOT+X,PRCTOT=PRCTOT+X
|
|
S Z=$P($P(PRCF11,"^",13),"%")
|
|
N MULT S MULT=1 I Z D
|
|
. S X=$FN(Z,"",3),MULT=1-(X/100)
|
|
. S X=$P(X,".",1)_$P(X,".",2)
|
|
. S Z=X,Z=$S(($L(Z))<5:"0"_Z,1:Z)
|
|
. Q
|
|
; values for 4th and 5th piece added in routine PRCFARR3
|
|
S PRCFX="5^"_Z(1)_"^"_$P(PRCF1,"^",6)_"^^^"
|
|
S PRCFX=PRCFX_$E(PRCF11,4,7)_$E(PRCF11,2,3)_"^"_Z_"^"
|
|
S Z=$P($P(PRCF11,"^",13),"%",2)
|
|
S PRCFX=PRCFX_$S(Z:+Z,1:"")_$S($P(Z,+Z,2)'="":"^P",1:"^")_"^^"
|
|
N I F I=1,2 I "0"[$P(Z,"%",I) S $P(PRCFX,U,9)=""
|
|
S PRCFX=PRCFX_$S(PRCFPR=1&($P(PRCF11,"^",9)="F"):"C",1:"P")_"^"
|
|
PPT ;N PPT,I S PPT="",I=0
|
|
;N PPR F S I=$O(^PRC(442,PRCFA("PODA"),5,I)) Q:+I'=I S PPR=$G(^(I,0)) D
|
|
;. Q:PPR="" I $P(PPR,U,1)="NET",$P(PPR,U,5)]"" S PPT=$P(PPR,U,5)
|
|
;. I PPT="" S PPT=$P(PPR,U,5)
|
|
;. Q
|
|
S $P(PRCFX,U,10)=$P($G(^PRC(442,PRCFA("PODA"),12)),U,15)
|
|
VC N PRCFVP,PRCFV3 S PRCFVP=+PRCF1,PRCFV3=$G(^PRC(440,PRCFVP,3))
|
|
N VC S VC=$P(PRCFV3,U,4) S:VC="" VC=$S($P($G(^PRC(440,PRCFVP,2)),U,2)]"":"MISCG",1:"MISCN")
|
|
S $P(PRCFX,U,12)=VC
|
|
I VC'?1"MISC".E S $P(PRCFX,U,13)=$P(PRCFV3,U,5)
|
|
I VC?1"MISC".E S $P(PRCFX,U,14)=$E($P($G(^PRC(440,PRCFVP,0)),U,1),1,30)
|
|
S $P(PRCFX,U,15)=$$FAP($P($G(^PRC(442,PRCFA("PODA"),11,PRCFPR,1)),U,17))
|
|
S ^TMP("PRCFARR",$J,5,0)=PRCFX_U,$P(^(0),U,16)="",PRCFX=""
|
|
G EN^PRCFARR1
|
|
FAMT I 'X S X="" Q
|
|
S X=$P(X,".")_$E($P(X,".",2)_"00",1,2) Q
|
|
FAP(X) ;Return Fiscal Accounting Period When Passed FM Date
|
|
Q:X="" X
|
|
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))
|
|
Q X
|