Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHFPT0

PRCHFPT0.m

Go to the documentation of this file.
PRCHFPT0 ;WISC/RSD/RHD/BGJ-CONTINUATION--PRINT FREE FORM 2138 ;4/21/99  18:05
V ;;5.1;IFCAP;**7**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
STP ;PRINT HEADER ON FIRST PAGE
 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* "
 S PRCHTYPE=$P($G(^PRC(442,D0,23)),U,11)
 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
 I $P(PRCHST,U,15)="Y" S %H=$H D YX^%DTC W "("_Y_")"
 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
 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)
 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
 S PRCHV=$G(^PRC(440,+PRCH1,0),U_">> No info for vendor: "_PRCH1)
 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
 W !,"VENDOR:",?53,"|SHIP TO:",!,?9,T,?53,"|",?62,$P(PRCHSHP,U,1) W:'PRCHS " ",$P($P(PRCH0,U,1),"-",2)
 S S=1 S:'PRCHS S(S)=PRCHFTYP,S=S+1
 I  S V=1
 E  D
 .  S V(1)=$P(PRCHV,U,2),V=2
 .  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
 .  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
 I $D(^PRC(440,+PRCH1,2)) S:$P(^(2),U,1)]"" V(V)="ACCT # "_$P(^(2),U,1),V=V+1 S V(V)=""
 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
 I V<9 S V=V+1,V(V)=""
 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)
 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"
 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"
 .S PRCHEDIT="",PRCHEDIT=$P($G(^PRC(442,D0,12)),U,14)
 .S PRCHEDIT=$S(PRCHEDIT'="":"*EDI EMERGENCY ORDER-"_$P($G(^PRC(443.4,PRCHEDIT,0)),U)_"*",1:"*EDI ORDER*") Q
 K PRCHEDI,PRCHEDIT
 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
 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
 I $P(PRCHSHP,U,8)]"",'PRCHS S S(S)="DELIVERY HOURS:",S=S+1,S(S)=$P(PRCHSHP,U,8)
 F I=1:1:9 W ! W:$D(V(I)) ?9,V(I) W ?53,"|" W:$D(S(I)) ?62,S(I)
 W ! W:$D(V(10)) ?5,V(10) W ?53,"|" W:$D(S(10)) ?62,S(10)
 F I=1:1:96 W @IOBS
 W $E(PRCHULN,1,53),"|",$E(PRCHULN,1,42)
 G ^PRCHFPT1