64 lines
4.3 KiB
Mathematica
64 lines
4.3 KiB
Mathematica
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
|