| 1 | PRCHFPT0 ;WISC/RSD/RHD/BGJ-CONTINUATION--PRINT FREE FORM 2138 ;4/21/99 18:05
|
|---|
| 2 | V ;;5.1;IFCAP;**7**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | STP ;PRINT HEADER ON FIRST PAGE
|
|---|
| 6 | S Y=$P(PRCH1,U,9) W:$Y>0 @IOF W !,?5,$S(Y="EM":"**EMERGENCY**",Y="SP":"*SPECIAL*",1:"") W:$D(PRCHREPR) ?20,"*REPRINT* "
|
|---|
| 7 | S PRCHTYPE=$P($G(^PRC(442,D0,23)),U,11)
|
|---|
| 8 | W ?28,$S("D"=PRCHTYPE:"DELIVERY ORDER",PRCHTYPE]"":"PURCHASE CARD ORDER",PRCHDES="US":" USING SERVICE COPY",$D(PRCHNRQ):"REQUISITION FOR SUPPLIES OR SERVICES",1:"PURCHASE ORDER FOR SUPPLIES OR SERVICES"),?70
|
|---|
| 9 | I $P(PRCHST,U,15)="Y" S %H=$H D YX^%DTC W "("_Y_")"
|
|---|
| 10 | W !?28,$E(PRCHULN,1,39),!,"ISSUING OFFICE:",?50,"REQUESTING SERVICE:",! S:'$D(PRC("SITE")) PRC("SITE")=+PRCH0 D FTYP^PRCHFPNT W "Dept. of Veterans Affairs "_$P(PRCHFTYP," ",2,99),?61
|
|---|
| 11 | S Y=$G(^DIC(49,+$P(PRCH1,U,2),0)) W $P(Y,U,1) W:$P(Y,U,8)]"" "(",$P(Y,U,8),")" W !,$P(PRCHHSP,U,1)," ",$P(PRCHHSP,U,2)
|
|---|
| 12 | W !,$P(PRCHHSP,U,3),", ",$P($G(^DIC(5,+$P(PRCHHSP,U,4),0)),U,2)," ",$P(PRCHHSP,U,5),?61,"DEL. TO: ",$P(PRCH1,U,11),!,PRCHULN
|
|---|
| 13 | S PRCHV=$G(^PRC(440,+PRCH1,0),U_">> No info for vendor: "_PRCH1)
|
|---|
| 14 | N T S T=$P(PRCHV,U,1) I T="SIMPLIFIED" N R S R=$P($G(^PRC(442,D0,24)),U,2) I R]"" S T=R
|
|---|
| 15 | W !,"VENDOR:",?53,"|SHIP TO:",!,?9,T,?53,"|",?62,$P(PRCHSHP,U,1) W:'PRCHS " ",$P($P(PRCH0,U,1),"-",2)
|
|---|
| 16 | S S=1 S:'PRCHS S(S)=PRCHFTYP,S=S+1
|
|---|
| 17 | I S V=1
|
|---|
| 18 | E D
|
|---|
| 19 | . S V(1)=$P(PRCHV,U,2),V=2
|
|---|
| 20 | . I $P(PRCHV,U,3)]"" S V(V)=$P(PRCHV,U,3),V=V+1 S:$P(PRCHV,U,4)]"" V(V)=$P(PRCHV,U,4),V=V+1 S:$P(PRCHV,U,5)]"" V(V)=$P(PRCHV,U,5),V=V+1
|
|---|
| 21 | . S V(V)=$S($P(PRCHV,U,6)]"":($P(PRCHV,U,6)_" "),1:"")_$P($G(^DIC(5,+$P(PRCHV,U,7),0)),U,2)_" "_$P(PRCHV,U,8),V=$S(V<5:3,1:2)+V
|
|---|
| 22 | I $D(^PRC(440,+PRCH1,2)) S:$P(^(2),U,1)]"" V(V)="ACCT # "_$P(^(2),U,1),V=V+1 S V(V)=""
|
|---|
| 23 | S:$P(PRCHV,U,10)]"" V(V)=$P(PRCHV,U,10) S PRCVFAX=$P($G(^PRC(440,+PRCH1,10)),U,6) S:PRCVFAX'="" V(V)=$G(V(V))_" FAX: "_PRCVFAX K PRCVFAX
|
|---|
| 24 | I V<9 S V=V+1,V(V)=""
|
|---|
| 25 | I $P(PRCHST,U,19)="Y",$D(^PRC(440,+PRCH1,3)),$P(^(3),U,4)'="" S V(V)=V(V)_"FMS Vendor Code: "_$P(^(3),U,4)_$P(^(3),U,5)
|
|---|
| 26 | I $P(PRCH1,U,4)="Y" S V(10)=" VERBAL PURCHASE ORDER" S:$P(PRCH1,U,5)="Y" V(10)=" CONFIRMATION COPY, PLEASE DO NOT DUPLICATE"
|
|---|
| 27 | S PRCHEDI=$G(^PRC(440,+PRCH1,3)) I PRCHEDI]"",$P(PRCHEDI,U,2)="Y",$P($G(^PRC(442,D0,12)),U,16)'="n" D S V(10)=PRCHEDIT_" DO NOT MAIL"
|
|---|
| 28 | .S PRCHEDIT="",PRCHEDIT=$P($G(^PRC(442,D0,12)),U,14)
|
|---|
| 29 | .S PRCHEDIT=$S(PRCHEDIT'="":"*EDI EMERGENCY ORDER-"_$P($G(^PRC(443.4,PRCHEDIT,0)),U)_"*",1:"*EDI ORDER*") Q
|
|---|
| 30 | K PRCHEDI,PRCHEDIT
|
|---|
| 31 | S:$P(PRCHSHP,U,2)]"" S(S)=$P(PRCHSHP,U,2),S=S+1 S:$P(PRCHSHP,U,3)]"" S(S)=$P(PRCHSHP,U,3),S=S+1 S:$P(PRCHSHP,U,4)]"" S(S)=$P(PRCHSHP,U,4),S=S+1
|
|---|
| 32 | S S(S)=$S($P(PRCHSHP,U,5)]"":($P(PRCHSHP,U,5)_", "),1:" ")_$P($G(^DIC(5,+$P(PRCHSHP,U,6),0)),U,2)_" "_$P(PRCHSHP,U,7),S=S+2
|
|---|
| 33 | I $P(PRCHSHP,U,8)]"",'PRCHS S S(S)="DELIVERY HOURS:",S=S+1,S(S)=$P(PRCHSHP,U,8)
|
|---|
| 34 | F I=1:1:9 W ! W:$D(V(I)) ?9,V(I) W ?53,"|" W:$D(S(I)) ?62,S(I)
|
|---|
| 35 | W ! W:$D(V(10)) ?5,V(10) W ?53,"|" W:$D(S(10)) ?62,S(10)
|
|---|
| 36 | F I=1:1:96 W @IOBS
|
|---|
| 37 | W $E(PRCHULN,1,53),"|",$E(PRCHULN,1,42)
|
|---|
| 38 | G ^PRCHFPT1
|
|---|
