1 | PRCFARR1 ;ISC-SF/TKW-CONT. OF RR FOR TRANSMISSION ;5/11/94 1:01 PM
|
---|
2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | EN ;#6 FISCAL DATA-PURCH.AUTHORITY,CONTRACTING OFFICER,P.O.DATE,TOTAL AMT.OF P.O.,APPROPRIATION,COST CENTER,FUND CONTROL PT.,OBLIGATED BY
|
---|
5 | S X="" F I=0:0 S I=$O(^PRC(442,PRCFPO,14,I)) Q:'I S Y=+^(I,0) I $D(^PRC(442.4,Y,0)) S:X]"" X=X_"," S X=X_$P(^(0),"^",2)
|
---|
6 | S PRCFX="6^"_X_"^",DA=PRCFPO,X=$$DECODE^PRCHES5(PRCFPO)
|
---|
7 | D RUP^PRCFARR3 S $P(X," ",35)=" ",X=$E(X,1,34)_" ",Y=$P(PRCF12,"^",3)
|
---|
8 | S X=X_$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)_"@"
|
---|
9 | S X=X_$E(Y,9,10)_":"_$E(Y,11,12),$P(PRCFX,"^",3)=X
|
---|
10 | S X=$P(PRCF1,"^",15),$P(PRCFX,"^",4)=$E(X,4,7)_$E(X,2,3)
|
---|
11 | S X=$P(PRCF0,"^",15) D FAMT^PRCFARR S $P(PRCFX,"^",5)=X
|
---|
12 | ;S X="000000"_+$E($P(PRCF0,"^",5),1,6),X=$E(X,($L(X)-5),$L(X))
|
---|
13 | ;S $P(PRCFX,"^",6,8)=$P(PRCF0,"^",4)_"^"_X_"^"_$P($P(PRCF0,"^",3)," ")_"^"
|
---|
14 | ;I $D(^PRC(442,PRCFPO,10,1,0)),$P(^(0),"^",5)]"" S X=$$DECODE^PRCHES4(PRCFPO,1)
|
---|
15 | S ^TMP("PRCFARR",$J,6,0)=PRCFX_"^"
|
---|
16 | ;#7 PAT BOCS & AMOUNTS,WHSE.SIGNATURE & RCVD.DATE,SERVICE SIGNATURE & RCVD.DATE
|
---|
17 | S PRCFX="7^" ;I $P(PRCF0,"^",7)=$P(PRCF11,"^",3)&($P(PRCF0,"^",9)=$P(PRCF11,"^",5)) G E1
|
---|
18 | ;S Z=$S($P(PRCF0,"^",8):$P(PRCF0,"^",6),1:""),X=$P(PRCF0,"^",7) D FAMT^PRCFARR S $P(PRCFX,"^",2,3)=Z_"^"_X
|
---|
19 | ;S X=$P(PRCF0,"^",9) D FAMT^PRCFARR S $P(PRCFX,"^",4,5)=$P(PRCF0,"^",8)_"^"_X
|
---|
20 | E1 S Z="",X=$$DECODE^PRCHES1(PRCFPO,PRCFPR) D RUP^PRCFARR3
|
---|
21 | S $P(PRCFX,"^",2)=X
|
---|
22 | S $P(PRCFX,"^",3)=$E($P(PRCF11,"^",11),4,7)_$E($P(PRCF11,"^",11),2,3)_"^^"
|
---|
23 | I $P(PRCF11,"^",16)]"" D
|
---|
24 | .S X=$$DECODE^PRCHES2(PRCFPO,PRCFPR) D RUP^PRCFARR3
|
---|
25 | .S $P(PRCFX,"^",4)=X
|
---|
26 | .S $P(PRCFX,"^",5)=$E($P(PRCF11,"^",17),4,7)_$E($P(PRCF11,"^",17),2,3)
|
---|
27 | .Q
|
---|
28 | S ^TMP("PRCFARR",$J,7,0)=PRCFX_"^",$P(^(0),U,6)=""
|
---|
29 | G EN^PRCFARR2
|
---|