| 1 | PRCHP18 ;SF/FKV-PRINT REQUEST FOR QUOTATIONS--STANDARD FORM 18 ;7/21/99 13:35
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN D:$D(ZTSK) KILL^%ZTLOAD K ZTSK Q:'$D(PRC("SITE")) S PRCHUNDL="",U="^" F I=1:1:98 S PRCHUNDL=PRCHUNDL_"_"
|
|---|
| 6 | I '$D(^PRC(411,+SITE,3)) W !!,"**** MISSING SITE ADDRESS--SITE "_SITE_" PROGRAM PRCHP18 **** !!!" G EXIT
|
|---|
| 7 | ; GET SITE ADDRESS FROM ADMIN.SITE PARAMETER FILE
|
|---|
| 8 | D FTYP1^PRCHFPNT
|
|---|
| 9 | 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)
|
|---|
| 10 | 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)=""
|
|---|
| 11 | ; GET 'DESTINATION' ADDRESS SELECTED BY OPERATOR, FROM ^TMP
|
|---|
| 12 | 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)
|
|---|
| 13 | 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)=""
|
|---|
| 14 | 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
|
|---|
| 15 | ; PRINT A REQUEST FOR QUOTATION FOR EACH VENDOR IN OPERATOR'S LIST
|
|---|
| 16 | S PRCHVCNT=0 D RDV W $C(13) G EXIT
|
|---|
| 17 | ;
|
|---|
| 18 | RDV N PRCHVFX,PRCHVPH,VENTENOD
|
|---|
| 19 | S PRCHVCNT=$O(^TMP($J,"V",PRCHVCNT)) Q:'PRCHVCNT
|
|---|
| 20 | I '$D(^PRCS(410,PRCHD0,0)) W !!,"*** MISSING REQUEST NUMBER "_PRCHD0_" -- PROGRAM PRCHP18 ***" G RDV
|
|---|
| 21 | ; GET VENDOR ADDRESS FROM VENDOR FILE
|
|---|
| 22 | S V=$G(^PRC(440,PRCHVCNT,0)) I V="" W !!,"*** MISSING VENDOR NUMBER "_PRCHVCNT_" -- PROGRAM PRCHP18 ***" G RDV
|
|---|
| 23 | S PRCHVPH=$P(V,U,10)
|
|---|
| 24 | 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)
|
|---|
| 25 | 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)=""
|
|---|
| 26 | S VENTENOD=$G(^PRC(440,PRCHVCNT,10))
|
|---|
| 27 | I $D(VENTENOD) S PRCHVFX=$P(VENTENOD,U,6)
|
|---|
| 28 | I '$D(^PRC(443,PRCHD0,0)) W !!,"*** MISSING P.A. INFORMATION FOR REQUEST "_$P(^PRCS(410,PRCHD0,0),U,1)_" ***" G RDV
|
|---|
| 29 | N PRCHPA,PRCHPAP,PRCPAFAX,PRCEMAIL
|
|---|
| 30 | S X=+$P(^PRC(443,PRCHD0,0),U,5)
|
|---|
| 31 | I X>0 D
|
|---|
| 32 | . N PRCX,DIC,DR,DA,DIQ
|
|---|
| 33 | . K ^UTILITY("DIQ1",$J)
|
|---|
| 34 | . S DIC=200,DR=".01;.135;.136;.151",DA=+X,DIQ="PRCX",DIQ(0)="I" D EN^DIQ1
|
|---|
| 35 | . S PRCHPA=PRCX(200,DA,.01,"I"),PRCHPAP=PRCX(200,DA,.135,"I")
|
|---|
| 36 | . S PRCPAFAX=PRCX(200,DA,.136,"I"),PRCEMAIL=PRCX(200,DA,.151,"I")
|
|---|
| 37 | . K ^UTILITY("DIQ1",$J)
|
|---|
| 38 | S PRCHPAGE=1
|
|---|
| 39 | 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",!
|
|---|
| 40 | 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,"|",!
|
|---|
| 41 | W $E(PRCHUNDL,1,25),"|",$E(PRCHUNDL,1,56),"|",$E(PRCHUNDL,1,7),"|",$E(PRCHUNDL,1,7),!
|
|---|
| 42 | W "1.REQUEST NO.",?14,"|2.DATE ISSUED",?30,"|3.REQUISITION/PURCHASE REQUEST",?63,"|4.CERT.FOR NAT.DEF.",?84,"|RATING",!
|
|---|
| 43 | W ?14,"|",?30,"|",?33,"NO.",?63,"|",?66,"UNDER BDSA REG.2",?84,"|",!
|
|---|
| 44 | W ?14,"|",?16,PRCHDT,?30,"|",?36,$P(^PRCS(410,PRCHD0,0),U,1),?63,"|",?66,"AND/OR DMS REG.1->",?84,"|",!
|
|---|
| 45 | W $E(PRCHUNDL,1,14)_"|"_$E(PRCHUNDL,1,15)_"|"_$E(PRCHUNDL,1,32)_"|"_$E(PRCHUNDL,1,20),"|",$E(PRCHUNDL,1,13),!
|
|---|
| 46 | W "5A.ISSUED BY",?14,PRCHS(1),?63,"|6.DELIVER BY (Date)",!
|
|---|
| 47 | W ?14,PRCHS(2),?63,"|",!,?14,PRCHS(3),?63,"| ",PRCHDT2,!,?14,PRCHS(4),?63,"|",$E(PRCHUNDL,1,34),!,$E(PRCHUNDL,1,63)_"|7.DELIVERY",!
|
|---|
| 48 | W "5B.FOR INFORMATION CALL:(Name & phone no.) (No collect calls)",?63,"|(Unless otherwise specified)"
|
|---|
| 49 | W !,?4,$G(PRCHPA)," PHONE: ",$G(PRCHPAP),?63,"|",?68,"FOB",?84,"OTHER",!
|
|---|
| 50 | W ?9,"FAX: ",$G(PRCPAFAX),?63,"|",?64,"_X__DESTINATION",?80,"____(See Schedule)",!
|
|---|
| 51 | W:$G(PRCEMAIL)]"" "E-MAIL: ",PRCEMAIL W ?63,"|",!
|
|---|
| 52 | W $E(PRCHUNDL,1,63),"|",$E(PRCHUNDL,1,34),!
|
|---|
| 53 | W "8.TO: NAME AND ADDRESS, INCLUDING ZIP CODE",?63,"|9.DESTINATION (Consignee and ad-",!
|
|---|
| 54 | W ?10,PRCHV(1),?63,"|",?69,"dress, including ZIP code)",! F I=2:1:5 W ?10,PRCHV(I),?63,"| ",PRCHD(I-1),!
|
|---|
| 55 | W "PHONE: "_$G(PRCHVPH),?32,"FAX: "_$G(PRCHVFX),?63,"|",!
|
|---|
| 56 | W:PRCHD(5)'="" ?63,"| ",PRCHD(5),! W $E(PRCHUNDL,1,63),"|",$E(PRCHUNDL,1,34),!
|
|---|
| 57 | G EN^PRCHP181
|
|---|
| 58 | ;
|
|---|
| 59 | ENDRPT G RDV
|
|---|
| 60 | ;
|
|---|
| 61 | EXIT K PRCHI,PRCHUNDL,D0,P,PRCHCNT,PRCHFTYP,PRCHIMAS,PRCHIOP,PRCHITEM,PRCHQTY,PRCHUNIT,PRCHX,PRCHD,PRCHD0,PRCHDT,PRCHDT1,PRCHDT2,PRCHPM,PRCHPA,PRCHPAGE
|
|---|
| 62 | K PRCHPAP,PRCHS,PRCHV,PRCHVCNT,PRCHDY,S,I,J,K,X,Y,PRCHFL,PRCHUP,PRCHNSN,PRCHVS,PRCHLI,^TMP($J)
|
|---|
| 63 | Q
|
|---|
