VistA-FOIAVistA/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFARR0.m

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