source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFARR1.m@ 1420

Last change on this file since 1420 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PRCFARR1 ;ISC-SF/TKW-CONT. OF RR FOR TRANSMISSION ;5/11/94 1:01 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ;#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
20E1 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
Note: See TracBrowser for help on using the repository browser.