PRCHP18 ;SF/FKV-PRINT REQUEST FOR QUOTATIONS--STANDARD FORM 18 ;7/21/99  13:35
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
EN D:$D(ZTSK) KILL^%ZTLOAD K ZTSK Q:'$D(PRC("SITE"))  S PRCHUNDL="",U="^" F I=1:1:98 S PRCHUNDL=PRCHUNDL_"_"
 I '$D(^PRC(411,+SITE,3)) W !!,"**** MISSING SITE ADDRESS--SITE "_SITE_" PROGRAM PRCHP18 **** !!!" G EXIT
 ; GET SITE ADDRESS FROM ADMIN.SITE PARAMETER FILE
 D FTYP1^PRCHFPNT
 K PRCHS S S=^PRC(411,+SITE,3),PRCHS(1)=PRCHFTYP_" Chief, A&MM Svc. (90C)",J=1 F I=1:1:2 I $P(S,U,I)'="" S J=J+1,PRCHS(J)=$P(S,U,I)
 S J=J+1,PRCHS(J)=$P(S,U,3)_",  "_$P($G(^DIC(5,+$P(S,U,4),0)),U,2)_"      "_$P(S,U,5) K S I J<4 F I=(J+1):1:4 S J=J+1,PRCHS(J)=""
 ; GET 'DESTINATION' ADDRESS SELECTED BY OPERATOR, FROM ^TMP
 K PRCHD S D=$G(^TMP($J,"D")),J=0 F I=1:1:4 I $P(D,U,I)'="" S J=J+1,PRCHD(J)=$P(D,U,I)
 S J=J+1,PRCHD(J)=$P(D,U,5)_",  "_$P($G(^DIC(5,+$P(D,U,6),0)),U,2)_"      "_$P(D,U,7) K D I J<5 F I=(J+1):1:5 S J=J+1,PRCHD(J)=""
 D NOW^%DTC S Y=X D DD^%DT S PRCHDT=Y,Y=PRCHDT1 D DD^%DT S PRCHDT1=Y,Y=PRCHDT2 D DD^%DT S PRCHDT2=Y
 ; PRINT A REQUEST FOR QUOTATION FOR EACH VENDOR IN OPERATOR'S LIST
 S PRCHVCNT=0 D RDV W $C(13) G EXIT
 ;
RDV N PRCHVFX,PRCHVPH,VENTENOD
 S PRCHVCNT=$O(^TMP($J,"V",PRCHVCNT)) Q:'PRCHVCNT
 I '$D(^PRCS(410,PRCHD0,0)) W !!,"*** MISSING REQUEST NUMBER "_PRCHD0_" -- PROGRAM PRCHP18 ***" G RDV
 ; GET VENDOR ADDRESS FROM VENDOR FILE
 S V=$G(^PRC(440,PRCHVCNT,0)) I V="" W !!,"*** MISSING VENDOR NUMBER "_PRCHVCNT_" -- PROGRAM PRCHP18 ***" G RDV
 S PRCHVPH=$P(V,U,10)
 K PRCHV S J=0 F I=1:1:4 I $P(V,U,I)'="" S J=J+1,PRCHV(J)=$P(V,U,I)
 S:J=4 PRCHV(J)=PRCHV(J)_" "_$P(V,U,5) S J=J+1,PRCHV(J)=$P(V,U,6)_",  "_$P($G(^DIC(5,+$P(V,U,7),0)),U,2)_"      "_$P(V,U,8) K V I J<5 F I=(J+1):1:5 S J=J+1,PRCHV(J)=""
 S VENTENOD=$G(^PRC(440,PRCHVCNT,10))
 I $D(VENTENOD) S PRCHVFX=$P(VENTENOD,U,6)
 I '$D(^PRC(443,PRCHD0,0)) W !!,"*** MISSING P.A. INFORMATION FOR REQUEST "_$P(^PRCS(410,PRCHD0,0),U,1)_" ***" G RDV
 N PRCHPA,PRCHPAP,PRCPAFAX,PRCEMAIL
 S X=+$P(^PRC(443,PRCHD0,0),U,5)
 I X>0 D
 . N PRCX,DIC,DR,DA,DIQ
 . K ^UTILITY("DIQ1",$J)
 . S DIC=200,DR=".01;.135;.136;.151",DA=+X,DIQ="PRCX",DIQ(0)="I" D EN^DIQ1
 . S PRCHPA=PRCX(200,DA,.01,"I"),PRCHPAP=PRCX(200,DA,.135,"I")
 . S PRCPAFAX=PRCX(200,DA,.136,"I"),PRCEMAIL=PRCX(200,DA,.151,"I")
 . K ^UTILITY("DIQ1",$J)
 S PRCHPAGE=1
 W @IOF,?65,"FORM APPROVED OMB NO. 2900-0445",!,PRCHUNDL,!,"REQUEST FOR QUOTATIONS   |",?28,"The Notice of Small Business-Small Purchase Set-Aside",?82,"|",?85,"PAGE OF PAGES",!
 W ?1,"(this is not an order)",?25,"|",?29,"on the last page of this form",?82,"|",?90,"|",!,?25,"|",?28,"_____is     _____is not applicable.",?82,"|   1",?90,"|",!
 W $E(PRCHUNDL,1,25),"|",$E(PRCHUNDL,1,56),"|",$E(PRCHUNDL,1,7),"|",$E(PRCHUNDL,1,7),!
 W "1.REQUEST NO.",?14,"|2.DATE ISSUED",?30,"|3.REQUISITION/PURCHASE REQUEST",?63,"|4.CERT.FOR NAT.DEF.",?84,"|RATING",!
 W ?14,"|",?30,"|",?33,"NO.",?63,"|",?66,"UNDER BDSA REG.2",?84,"|",!
 W ?14,"|",?16,PRCHDT,?30,"|",?36,$P(^PRCS(410,PRCHD0,0),U,1),?63,"|",?66,"AND/OR DMS REG.1->",?84,"|",!
 W $E(PRCHUNDL,1,14)_"|"_$E(PRCHUNDL,1,15)_"|"_$E(PRCHUNDL,1,32)_"|"_$E(PRCHUNDL,1,20),"|",$E(PRCHUNDL,1,13),!
 W "5A.ISSUED BY",?14,PRCHS(1),?63,"|6.DELIVER BY (Date)",!
 W ?14,PRCHS(2),?63,"|",!,?14,PRCHS(3),?63,"|  ",PRCHDT2,!,?14,PRCHS(4),?63,"|",$E(PRCHUNDL,1,34),!,$E(PRCHUNDL,1,63)_"|7.DELIVERY",!
 W "5B.FOR INFORMATION CALL:(Name & phone no.) (No collect calls)",?63,"|(Unless otherwise specified)"
 W !,?4,$G(PRCHPA),"   PHONE: ",$G(PRCHPAP),?63,"|",?68,"FOB",?84,"OTHER",!
 W ?9,"FAX: ",$G(PRCPAFAX),?63,"|",?64,"_X__DESTINATION",?80,"____(See Schedule)",!
 W:$G(PRCEMAIL)]"" "E-MAIL: ",PRCEMAIL W ?63,"|",!
 W $E(PRCHUNDL,1,63),"|",$E(PRCHUNDL,1,34),!
 W "8.TO: NAME AND ADDRESS, INCLUDING ZIP CODE",?63,"|9.DESTINATION (Consignee and ad-",!
 W ?10,PRCHV(1),?63,"|",?69,"dress, including ZIP code)",! F I=2:1:5 W ?10,PRCHV(I),?63,"|  ",PRCHD(I-1),!
 W "PHONE: "_$G(PRCHVPH),?32,"FAX: "_$G(PRCHVFX),?63,"|",!
 W:PRCHD(5)'="" ?63,"|  ",PRCHD(5),! W $E(PRCHUNDL,1,63),"|",$E(PRCHUNDL,1,34),!
 G EN^PRCHP181
 ;
ENDRPT G RDV
 ;
EXIT K PRCHI,PRCHUNDL,D0,P,PRCHCNT,PRCHFTYP,PRCHIMAS,PRCHIOP,PRCHITEM,PRCHQTY,PRCHUNIT,PRCHX,PRCHD,PRCHD0,PRCHDT,PRCHDT1,PRCHDT2,PRCHPM,PRCHPA,PRCHPAGE
 K PRCHPAP,PRCHS,PRCHV,PRCHVCNT,PRCHDY,S,I,J,K,X,Y,PRCHFL,PRCHUP,PRCHNSN,PRCHVS,PRCHLI,^TMP($J)
 Q