source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHP18.m@ 1799

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

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1PRCHP18 ;SF/FKV-PRINT REQUEST FOR QUOTATIONS--STANDARD FORM 18 ;7/21/99 13:35
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN 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 ;
18RDV 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 ;
59ENDRPT G RDV
60 ;
61EXIT 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
Note: See TracBrowser for help on using the repository browser.