ACRFPQT ;IHS/OIRM/DSD/THL,AEF - PREPARE REQUEST FOR QUOTES: [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
EN ;EP;TO ADD BIDDERS TO THE BIDDERS LIST
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACRQUIT,ACRX,ACRY,ACRZ
Q
EN1 ;
N ACR,ACRJ,ACRVDA
D BIDDERS:$D(^ACRDOC(ACRDOCDA,60,0))
D CHOICE
Q
CHOICE S DIR(0)="SO^1:ADD Vendor to BIDDER'S List"_$S($D(^ACRDOC(ACRDOCDA,60,0)):";2:REMOVE Vendor from BIDDER'S List;3:PRINT Request for Quote for each BIDDER",1:"")
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
I '$G(Y) S ACRQUIT="" Q
I Y=1 D ADD S Y=1
I Y=2 D REMOVE S Y=2
I Y=3 D PRINT S Y=2
Q
ADD F D A Q:$D(ACROUT)!$D(ACRQUIT)
K ACRQUIT
Q
A S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="Vendor/Contractor: "
W !
D DIC^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!($G(Y)<1) S ACRQUIT="" Q
S:'$D(^ACRDOC(ACRDOCDA,60,0)) ^ACRDOC(ACRDOCDA,60,0)="^9002196.09P"
S X=+Y
S (DA,DA(1))=ACRDOCDA
S DIC="^ACRDOC("_ACRDOCDA_",60,"
S DIC(0)="L"
D FILE^ACRFDIC
Q
BIDDERS W @IOF
W !?15,"BIDDERS FOR REQUISITION NO. ",ACRDOC
W !?15,"-------------------------------------------"
S (ACR,ACRJ)=0
F S ACR=$O(^ACRDOC(ACRDOCDA,60,ACR)) Q:'ACR D
.S ACRJ=ACRJ+1
.S ACRVDA=+$G(^ACRDOC(ACRDOCDA,60,ACR,0))
.Q:'ACRVDA
.Q:'$D(^AUTTVNDR(ACRVDA,0))
.S ACR(ACRJ)=ACR_U_ACRVDA
.W !?15,ACRJ
.W ?20,$P(^AUTTVNDR(ACRVDA,0),U)
Q
REMOVE ;REMOVE BIDDERS FROM THE BIDDERS LIST
S DIR(0)="LO^1:"_ACRJ
S DIR("A")="Remove which Bidder"_$S(ACRJ>1:"s",1:"")
W !
D DIR^ACRFDIC
I $D(ACROUT)!$D(ACRQUIT)!'$G(Y) K ACRQUIT Q
S ACRZ=Y
N J
F J=1:1 S ACRX=$P(ACRZ,",",J) Q:ACRX="" I $D(ACR(ACRX)) D
.S DA=+ACR(ACRX)
.S DA(1)=ACRDOCDA
.S DIK="^ACRDOC("_ACRDOCDA_",60,"
.D ^DIK
Q
PRINT ;PRINT RFQ FOR EACH BIDDER
S ZTDESC="PRINT BIDDER'S LIST FOR "_ACRDOC
S (ZTRTN,ACRRTN)="P^ACRFPQT"
D ^ACRFZIS
Q
P ;EP;TO PRINT RFQ FOR EACH BIDDER
N ACRPQT,ACRJ,ACRVDA,ACRVEND
S ACRVEND=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5)
S (ACRPQT,ACRJ)=0
F S ACRPQT=$O(^ACRDOC(ACRDOCDA,60,ACRPQT)) Q:'ACRPQT D
.S ACRJ=ACRJ+1
.S ACRVDA=+$G(^ACRDOC(ACRDOCDA,60,ACRPQT,0))
.Q:'ACRVDA
.Q:'$D(^AUTTVNDR(ACRVDA,0))
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="103070////"_ACRVDA
.D DIE^ACRFDIC
.S D0=ACRDOCDA
.D ^ACRPQT
.W @IOF
I ACRVEND D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="103070////"_ACRVEND
.D DIE^ACRFDIC
Q
ACRFPQT ;IHS/OIRM/DSD/THL,AEF - PREPARE REQUEST FOR QUOTES: [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
EN ;EP;TO ADD BIDDERS TO THE BIDDERS LIST
+1 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACRQUIT,ACRX,ACRY,ACRZ
+1 QUIT
EN1 ;
+1 NEW ACR,ACRJ,ACRVDA
+2 IF $DATA(^ACRDOC(ACRDOCDA,60,0))
DO BIDDERS
+3 DO CHOICE
+4 QUIT
CHOICE SET DIR(0)="SO^1:ADD Vendor to BIDDER'S List"_$SELECT($DATA(^ACRDOC(ACRDOCDA,60,0)):";2:REMOVE Vendor from BIDDER'S List;3:PRINT Request for Quote for each BIDDER",1:"")
+1 SET DIR("A")="Which one"
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+5 IF '$GET(Y)
SET ACRQUIT=""
QUIT
+6 IF Y=1
DO ADD
SET Y=1
+7 IF Y=2
DO REMOVE
SET Y=2
+8 IF Y=3
DO PRINT
SET Y=2
+9 QUIT
ADD FOR
DO A
IF $DATA(ACROUT)!$DATA(ACRQUIT)
QUIT
+1 KILL ACRQUIT
+2 QUIT
A SET DIC="^AUTTVNDR("
+1 SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Vendor/Contractor: "
+3 WRITE !
+4 DO DIC^ACRFDIC
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)!($GET(Y)<1)
SET ACRQUIT=""
QUIT
+6 IF '$DATA(^ACRDOC(ACRDOCDA,60,0))
SET ^ACRDOC(ACRDOCDA,60,0)="^9002196.09P"
+7 SET X=+Y
+8 SET (DA,DA(1))=ACRDOCDA
+9 SET DIC="^ACRDOC("_ACRDOCDA_",60,"
+10 SET DIC(0)="L"
+11 DO FILE^ACRFDIC
+12 QUIT
BIDDERS WRITE @IOF
+1 WRITE !?15,"BIDDERS FOR REQUISITION NO. ",ACRDOC
+2 WRITE !?15,"-------------------------------------------"
+3 SET (ACR,ACRJ)=0
+4 FOR
SET ACR=$ORDER(^ACRDOC(ACRDOCDA,60,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+5 SET ACRJ=ACRJ+1
+6 SET ACRVDA=+$GET(^ACRDOC(ACRDOCDA,60,ACR,0))
+7 IF 'ACRVDA
QUIT
+8 IF '$DATA(^AUTTVNDR(ACRVDA,0))
QUIT
+9 SET ACR(ACRJ)=ACR_U_ACRVDA
+10 WRITE !?15,ACRJ
+11 WRITE ?20,$PIECE(^AUTTVNDR(ACRVDA,0),U)
End DoDot:1
+12 QUIT
REMOVE ;REMOVE BIDDERS FROM THE BIDDERS LIST
+1 SET DIR(0)="LO^1:"_ACRJ
+2 SET DIR("A")="Remove which Bidder"_$SELECT(ACRJ>1:"s",1:"")
+3 WRITE !
+4 DO DIR^ACRFDIC
+5 IF $DATA(ACROUT)!$DATA(ACRQUIT)!'$GET(Y)
KILL ACRQUIT
QUIT
+6 SET ACRZ=Y
+7 NEW J
+8 FOR J=1:1
SET ACRX=$PIECE(ACRZ,",",J)
IF ACRX=""
QUIT
IF $DATA(ACR(ACRX))
Begin DoDot:1
+9 SET DA=+ACR(ACRX)
+10 SET DA(1)=ACRDOCDA
+11 SET DIK="^ACRDOC("_ACRDOCDA_",60,"
+12 DO ^DIK
End DoDot:1
+13 QUIT
PRINT ;PRINT RFQ FOR EACH BIDDER
+1 SET ZTDESC="PRINT BIDDER'S LIST FOR "_ACRDOC
+2 SET (ZTRTN,ACRRTN)="P^ACRFPQT"
+3 DO ^ACRFZIS
+4 QUIT
P ;EP;TO PRINT RFQ FOR EACH BIDDER
+1 NEW ACRPQT,ACRJ,ACRVDA,ACRVEND
+2 SET ACRVEND=$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
+3 SET (ACRPQT,ACRJ)=0
+4 FOR
SET ACRPQT=$ORDER(^ACRDOC(ACRDOCDA,60,ACRPQT))
IF 'ACRPQT
QUIT
Begin DoDot:1
+5 SET ACRJ=ACRJ+1
+6 SET ACRVDA=+$GET(^ACRDOC(ACRDOCDA,60,ACRPQT,0))
+7 IF 'ACRVDA
QUIT
+8 IF '$DATA(^AUTTVNDR(ACRVDA,0))
QUIT
+9 SET DA=ACRDOCDA
+10 SET DIE="^ACRDOC("
+11 SET DR="103070////"_ACRVDA
+12 DO DIE^ACRFDIC
+13 SET D0=ACRDOCDA
+14 DO ^ACRPQT
+15 WRITE @IOF
End DoDot:1
+16 IF ACRVEND
Begin DoDot:1
+17 SET DA=ACRDOCDA
+18 SET DIE="^ACRDOC("
+19 SET DR="103070////"_ACRVEND
+20 DO DIE^ACRFDIC
End DoDot:1
+21 QUIT
