- 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
