PRCHQ14 ;(WASH IRMFO)/LKG-RFQ ReOpen RFQ ;8/6/96 20:47
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
ENT ;Entry point for Reopen RFQ
K DIC S DIC=444,DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,8)=3"
S DIC("A")="Select RFQ to ReOpen: " D ^DIC K DIC
G EX:+Y<1!$D(DTOUT)!$D(DUOUT)
S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
L +^PRC(444,PRCDA):5 E W !,"This RFQ is in use, please try later!" G ENT
K DIR S DIR(0)="YA",DIR("A")="Do you wish to review a synopsis of this RFQ? "
S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to ReOpening."
D ^DIR K DIR I $D(DIRUT)!$D(DIROUT) L -^PRC(444,PRCDA) G EX
I Y=1 D G:Y'=1 UNLOCK
. N L,DIC,DR,FLDS,BY,FR,TO,IOP S DIC=444,BY=.01,(FR,TO)=PRCRFQ,L=0,IOP="HOME"
. S FLDS="[PRCHQ RFQ SYNOPSIS]" D EN1^DIP K DIC,FLDS,BY,FR,DR,L
. S DIR(0)="YA",DIR("A")="Is this the correct RFQ? ",DIR("B")="YES"
. S DIR("?")="Answer 'NO' to abort the ReOpening."
. D ^DIR K DIR
S PRCMSG="" D ESIG^PRCUESIG(DUZ,.PRCMSG) I PRCMSG'=1 L -^PRC(444,PRCDA) G EX
S PRCOLD=$P(^PRC(444,PRCDA,0),U,3) D NOW^%DTC S PRCDT=%
S (PRCORDT,PRCRDT)=$P($G(^PRC(444,PRCDA,1)),U,2)\1,PRCRDTE=+$E(PRCRDT,4,5)_"/"_(+$E(PRCRDT,6,7))_"/"_$E(PRCRDT,2,3)
S DA=PRCDA,DIE=444
S DR="13;S PRCRDT=X,PRCRDTE=+$E(PRCRDT,4,5)_""/""_(+$E(PRCRDT,6,7))_""/""_$E(PRCRDT,2,3)"
S DR(1,444,1)="2;S PRCDD=X;I PRCDT>PRCDD W !,""Quote Due Date must be in the Future"" S Y=2;I PRCDD'<PRCRDT W !,""Quote Due Date must be earlier than Required Delivery Date ""_PRCRDTE S Y=2"
D ^DIE K DIE,DR,DA
I $D(Y)!$D(DTOUT) D G UNLOCK
. S DA=PRCDA,DIE=444,DR="13////^S X=PRCORDT;2////^S X=PRCOLD" D ^DIE K DA,DIE,DR
. W !,"The Status and Quote Due Date for RFQ #"_PRCRFQ_" are unchanged!"
S DR="7////2;20.7////^S X=DUZ;20.8////^S X=PRCDT"
S DA=PRCDA,DIE=444 D ^DIE K DA,DIE,DR
K PRCAR S PRCAR(1)="The Status of RFQ #"_PRCRFQ_" has been changed from CLOSED"
S PRCAR(2)=" to PENDING QUOTES"
D EN^DDIOL(.PRCAR) K PRCAR
G:$P($G(^PRC(444,PRCDA,1)),U,11)="" UNLOCK
K DIR S DIR(0)="YA",DIR("A")="Do you wish to send an electronic notification to the vendors? "
S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to send a text message."
D ^DIR K DIR G:Y'=1 UNLOCK
S PRCX=$G(^PRC(444,PRCDA,1)),PRCMSGN=$P(PRCX,U,5)+1,PRCOUTN=$P(PRCX,U,6)+1
K DD,DO S DA(1)=PRCDA,DIC="^PRC(444,DA(1),7,",DIC(0)="L"
S DIC("P")=$P(^DD(444,21,0),U,2),X=PRCMSGN,DINUM=PRCMSGN,DLAYGO=444.021
D FILE^DICN K DIC,DINUM,DLAYGO
I Y<1 W !,"No Reopening Message has been entered!" L -^PRC(444,PRCDA) G UNLOCK
S PRCDA2=+Y
S $P(^PRC(444,PRCDA,1),U,5,6)=PRCMSGN_U_PRCOUTN
K ^UTILITY("DIQ1",$J) S DA=DUZ,DIC=200,DR=".01;.135" D EN^DIQ1
S PRCA=^UTILITY("DIQ1",$J,200,DA,.01),PRCB=^(.135) K ^UTILITY("DIQ1",$J)
S DA=PRCDA2,DA(1)=PRCDA,DIE="^PRC(444,DA(1),7,"
S DR="1////O;4///^S X=PRCOUTN;5///NOW;6///NOW;7///^S X=PRCA" D ^DIE
I PRCB]"" S DR="8///^S X=PRCB" D ^DIE
S PRCA=$P($G(^PRC(444,PRCDA,1)),U,8) I PRCA]"" S DR="12////^S X=PRCA" D ^DIE
S PRCX="** RFQ Reopening Message **",DR="9///^S X=PRCX" D ^DIE
S DR="13////^S X=DUZ;13.1////^S X=PRCDT" D ^DIE
K DIE,DR,DA,PRCA,PRCB,PRCX,PRCMSGN,PRCOUTN
I $P($G(^PRC(444,PRCDA,5,0)),U,4)>0 D
. N PRCX,PRCY,PRCDA3
. S PRCX=0,PRCDA3=0
. F S PRCX=$O(^PRC(444,PRCDA,5,PRCX)) Q:PRCX'?1.N D
. . S PRCY=$G(^PRC(444,PRCDA,5,PRCX,0)) Q:PRCY=""
. . Q:$P(PRCY,U,2)'="e"&($P(PRCY,U,2)'="b") S PRCY=$P(PRCY,U) Q:PRCY=""
. . S PRCDA3=PRCDA3+1,^PRC(444,PRCDA,7,PRCDA2,3,PRCDA3,0)=PRCY
. . S ^PRC(444,PRCDA,7,PRCDA2,3,"B",PRCY,PRCDA3)=""
. S:PRCDA3>0 ^PRC(444,PRCDA,7,PRCDA2,3,0)=U_$P(^DD(444.021,11,0),U,2)_U_PRCDA3_U_PRCDA3
S PRCDD=$P($G(^PRC(444,PRCDA,0)),U,3) S Y=PRCDD D DD^%DT S Y=$P(Y,":",1,2)
S ^PRC(444,PRCDA,7,PRCDA2,2,1,0)="This is to notify you that RFQ #: "_PRCRFQ_" has been"
S ^PRC(444,PRCDA,7,PRCDA2,2,2,0)="reopened with a new Quote Due Date of "_Y_". "
S ^PRC(444,PRCDA,7,PRCDA2,2,0)="^^2^2^"_$P(PRCDT,".")
K DA S DA=PRCDA2,DA(1)=PRCDA,DIE="^PRC(444,DA(1),7,",DR="10Reopening Message"
D ^DIE K DA,DIE,DR
K PRCERR
D TRANS864^PRCHQ4A
D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
K PRCDA2,PRCERR
UNLOCK L -^PRC(444,PRCDA) K DA,PRCX,PRCMSGN,PRCOUTN,PRCDA,PRCDA2,PRCDD
G:'$D(DTOUT) ENT
EX K PRCDA,PRCRFQ,PRCDT,PRCDD,PRCOLD,PRCORDT,PRCMSG,PRCRDT,PRCRDTE,DTOUT,DUOUT,DIROUT,DIRUT,DA,DIE,DR,%,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ14 4368 printed Dec 13, 2024@02:09:37 Page 2
PRCHQ14 ;(WASH IRMFO)/LKG-RFQ ReOpen RFQ ;8/6/96 20:47
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
ENT ;Entry point for Reopen RFQ
+1 KILL DIC
SET DIC=444
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,8)=3"
+2 SET DIC("A")="Select RFQ to ReOpen: "
DO ^DIC
KILL DIC
+3 if +Y<1!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EX
+4 SET PRCDA=+Y
SET PRCRFQ=$PIECE(Y,U,2)
+5 LOCK +^PRC(444,PRCDA):5
IF '$TEST
WRITE !,"This RFQ is in use, please try later!"
GOTO ENT
+6 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to review a synopsis of this RFQ? "
+7 SET DIR("B")="YES"
SET DIR("?")="Answer 'YES' if you wish to view the RFQ prior to ReOpening."
+8 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DIROUT)
LOCK -^PRC(444,PRCDA)
GOTO EX
+9 IF Y=1
Begin DoDot:1
+10 NEW L,DIC,DR,FLDS,BY,FR,TO,IOP
SET DIC=444
SET BY=.01
SET (FR,TO)=PRCRFQ
SET L=0
SET IOP="HOME"
+11 SET FLDS="[PRCHQ RFQ SYNOPSIS]"
DO EN1^DIP
KILL DIC,FLDS,BY,FR,DR,L
+12 SET DIR(0)="YA"
SET DIR("A")="Is this the correct RFQ? "
SET DIR("B")="YES"
+13 SET DIR("?")="Answer 'NO' to abort the ReOpening."
+14 DO ^DIR
KILL DIR
End DoDot:1
if Y'=1
GOTO UNLOCK
+15 SET PRCMSG=""
DO ESIG^PRCUESIG(DUZ,.PRCMSG)
IF PRCMSG'=1
LOCK -^PRC(444,PRCDA)
GOTO EX
+16 SET PRCOLD=$PIECE(^PRC(444,PRCDA,0),U,3)
DO NOW^%DTC
SET PRCDT=%
+17 SET (PRCORDT,PRCRDT)=$PIECE($GET(^PRC(444,PRCDA,1)),U,2)\1
SET PRCRDTE=+$EXTRACT(PRCRDT,4,5)_"/"_(+$EXTRACT(PRCRDT,6,7))_"/"_$EXTRACT(PRCRDT,2,3)
+18 SET DA=PRCDA
SET DIE=444
+19 SET DR="13;S PRCRDT=X,PRCRDTE=+$E(PRCRDT,4,5)_""/""_(+$E(PRCRDT,6,7))_""/""_$E(PRCRDT,2,3)"
+20 SET DR(1,444,1)="2;S PRCDD=X;I PRCDT>PRCDD W !,""Quote Due Date must be in the Future"" S Y=2;I PRCDD'<PRCRDT W !,""Quote Due Date must be earlier than Required Delivery Date ""_PRCRDTE S Y=2"
+21 DO ^DIE
KILL DIE,DR,DA
+22 IF $DATA(Y)!$DATA(DTOUT)
Begin DoDot:1
+23 SET DA=PRCDA
SET DIE=444
SET DR="13////^S X=PRCORDT;2////^S X=PRCOLD"
DO ^DIE
KILL DA,DIE,DR
+24 WRITE !,"The Status and Quote Due Date for RFQ #"_PRCRFQ_" are unchanged!"
End DoDot:1
GOTO UNLOCK
+25 SET DR="7////2;20.7////^S X=DUZ;20.8////^S X=PRCDT"
+26 SET DA=PRCDA
SET DIE=444
DO ^DIE
KILL DA,DIE,DR
+27 KILL PRCAR
SET PRCAR(1)="The Status of RFQ #"_PRCRFQ_" has been changed from CLOSED"
+28 SET PRCAR(2)=" to PENDING QUOTES"
+29 DO EN^DDIOL(.PRCAR)
KILL PRCAR
+30 if $PIECE($GET(^PRC(444,PRCDA,1)),U,11)=""
GOTO UNLOCK
+31 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to send an electronic notification to the vendors? "
+32 SET DIR("B")="YES"
SET DIR("?")="Answer 'YES' if you wish to send a text message."
+33 DO ^DIR
KILL DIR
if Y'=1
GOTO UNLOCK
+34 SET PRCX=$GET(^PRC(444,PRCDA,1))
SET PRCMSGN=$PIECE(PRCX,U,5)+1
SET PRCOUTN=$PIECE(PRCX,U,6)+1
+35 KILL DD,DO
SET DA(1)=PRCDA
SET DIC="^PRC(444,DA(1),7,"
SET DIC(0)="L"
+36 SET DIC("P")=$PIECE(^DD(444,21,0),U,2)
SET X=PRCMSGN
SET DINUM=PRCMSGN
SET DLAYGO=444.021
+37 DO FILE^DICN
KILL DIC,DINUM,DLAYGO
+38 IF Y<1
WRITE !,"No Reopening Message has been entered!"
LOCK -^PRC(444,PRCDA)
GOTO UNLOCK
+39 SET PRCDA2=+Y
+40 SET $PIECE(^PRC(444,PRCDA,1),U,5,6)=PRCMSGN_U_PRCOUTN
+41 KILL ^UTILITY("DIQ1",$JOB)
SET DA=DUZ
SET DIC=200
SET DR=".01;.135"
DO EN^DIQ1
+42 SET PRCA=^UTILITY("DIQ1",$JOB,200,DA,.01)
SET PRCB=^(.135)
KILL ^UTILITY("DIQ1",$JOB)
+43 SET DA=PRCDA2
SET DA(1)=PRCDA
SET DIE="^PRC(444,DA(1),7,"
+44 SET DR="1////O;4///^S X=PRCOUTN;5///NOW;6///NOW;7///^S X=PRCA"
DO ^DIE
+45 IF PRCB]""
SET DR="8///^S X=PRCB"
DO ^DIE
+46 SET PRCA=$PIECE($GET(^PRC(444,PRCDA,1)),U,8)
IF PRCA]""
SET DR="12////^S X=PRCA"
DO ^DIE
+47 SET PRCX="** RFQ Reopening Message **"
SET DR="9///^S X=PRCX"
DO ^DIE
+48 SET DR="13////^S X=DUZ;13.1////^S X=PRCDT"
DO ^DIE
+49 KILL DIE,DR,DA,PRCA,PRCB,PRCX,PRCMSGN,PRCOUTN
+50 IF $PIECE($GET(^PRC(444,PRCDA,5,0)),U,4)>0
Begin DoDot:1
+51 NEW PRCX,PRCY,PRCDA3
+52 SET PRCX=0
SET PRCDA3=0
+53 FOR
SET PRCX=$ORDER(^PRC(444,PRCDA,5,PRCX))
if PRCX'?1.N
QUIT
Begin DoDot:2
+54 SET PRCY=$GET(^PRC(444,PRCDA,5,PRCX,0))
if PRCY=""
QUIT
+55 if $PIECE(PRCY,U,2)'="e"&($PIECE(PRCY,U,2)'="b")
QUIT
SET PRCY=$PIECE(PRCY,U)
if PRCY=""
QUIT
+56 SET PRCDA3=PRCDA3+1
SET ^PRC(444,PRCDA,7,PRCDA2,3,PRCDA3,0)=PRCY
+57 SET ^PRC(444,PRCDA,7,PRCDA2,3,"B",PRCY,PRCDA3)=""
End DoDot:2
+58 if PRCDA3>0
SET ^PRC(444,PRCDA,7,PRCDA2,3,0)=U_$PIECE(^DD(444.021,11,0),U,2)_U_PRCDA3_U_PRCDA3
End DoDot:1
+59 SET PRCDD=$PIECE($GET(^PRC(444,PRCDA,0)),U,3)
SET Y=PRCDD
DO DD^%DT
SET Y=$PIECE(Y,":",1,2)
+60 SET ^PRC(444,PRCDA,7,PRCDA2,2,1,0)="This is to notify you that RFQ #: "_PRCRFQ_" has been"
+61 SET ^PRC(444,PRCDA,7,PRCDA2,2,2,0)="reopened with a new Quote Due Date of "_Y_". "
+62 SET ^PRC(444,PRCDA,7,PRCDA2,2,0)="^^2^2^"_$PIECE(PRCDT,".")
+63 KILL DA
SET DA=PRCDA2
SET DA(1)=PRCDA
SET DIE="^PRC(444,DA(1),7,"
SET DR="10Reopening Message"
+64 DO ^DIE
KILL DA,DIE,DR
+65 KILL PRCERR
+66 DO TRANS864^PRCHQ4A
+67 if $GET(PRCERR)
DO EN^DDIOL("Electronic Transmission Aborted!")
+68 KILL PRCDA2,PRCERR
UNLOCK LOCK -^PRC(444,PRCDA)
KILL DA,PRCX,PRCMSGN,PRCOUTN,PRCDA,PRCDA2,PRCDD
+1 if '$DATA(DTOUT)
GOTO ENT
EX KILL PRCDA,PRCRFQ,PRCDT,PRCDD,PRCOLD,PRCORDT,PRCMSG,PRCRDT,PRCRDTE,DTOUT,DUOUT,DIROUT,DIRUT,DA,DIE,DR,%,X,Y
+1 QUIT
