- PRCHQ10 ;(WASH IRMFO)/LKG-RFQ CLOSE ;8/6/96 20:42
- ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Close RFQ and Transmit 864 Text Message notification
- K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";2;""[("";""_$P(^(0),U,8)_"";"")"
- S DIC("A")="Select RFQ to Close: " D ^DIC K DIC
- G EX1:+Y<1!$D(DTOUT)!$D(DUOUT)
- S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
- L +^PRC(444,PRCDA):5 E W !,"This RFQ entry is in use, please try later!" G EN
- 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 Closure."
- D ^DIR K DIR
- I Y=1 D G:Y'=1 EX1
- . 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")="NO"
- . S DIR("?")="Answer 'NO' to abort the Closure."
- . D ^DIR K DIR
- S PRCMSG="" D ESIG^PRCUESIG(DUZ,.PRCMSG) G:PRCMSG'=1 EX1
- S PRCDUZ=DUZ D CLOSE
- G EN
- CLOSE ;Close RFQ to further quotes
- D NOW^%DTC S PRCDT=% K %
- G:$P($G(^PRC(444,PRCDA,1)),U,11)="" STATUS
- 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:'$D(ZTQUEUED) !,"No 864 Text Message has been entered!" L -^PRC(444,PRCDA) D EX1 Q
- S PRCDA2=+Y
- S $P(^PRC(444,PRCDA,1),U,5,6)=PRCMSGN_U_PRCOUTN
- K ^UTILITY("DIQ1",$J) S DA=PRCDUZ,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 Closure Notification **",DR="9///^S X=PRCX" D ^DIE
- S DR="13////^S X=PRCDUZ;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 ^PRC(444,PRCDA,7,PRCDA2,2,1,0)="This is to notify you that RFQ #: "_PRCRFQ_" has "
- S ^PRC(444,PRCDA,7,PRCDA2,2,2,0)="been closed to further quotes."
- S ^PRC(444,PRCDA,7,PRCDA2,2,0)="^^2^2^"_$P(PRCDT,".")
- K PRCERR
- D TRANS864^PRCHQ4A
- I $G(PRCERR),'$D(ZTQUEUED) D EN^DDIOL("Electronic Transmission Aborted!")
- K PRCDA2,PRCERR
- STATUS S DIE=444,DA=PRCDA,DR="7////3;20.7////^S X=PRCDUZ;20.8////^S X=PRCDT"
- D ^DIE K DIE,DR,PRCDT
- L -^PRC(444,PRCDA)
- Q
- EX1 L:$D(PRCDA) -^PRC(444,PRCDA) K PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- K DA,PRCX,PRCMSGN,PRCOUTN,DA,DD,DO,PRCDT,PRCMSG,PRCDUZ
- Q
- BKGND ;Automatic closure upon reaching Quote Due Date. This code
- ;;can be invoked as a Scheduled Option
- K ^TMP($J,"RFQ"),^TMP($J,"PRCHQ10") D:'$D(U)!'$D(DUZ) DT^DICRW
- N PRCDA,PRCDUZ,PRCLCNT,PRCQDT
- S ^TMP($J,"RFQ",1)="The following RFQs have been closed automatically as the Quote Due Date"
- S ^TMP($J,"RFQ",2)="has been reached.",^TMP($J,"RFQ",3)=" "
- S PRCDA=0,PRCLCNT=3
- S PRCDA=0
- F S PRCDA=$O(^PRC(444,"AH",2,PRCDA)) Q:PRCDA="" D
- . N PRCDT,PRCX,PRCMSGN,PRCOUTN,DD,DO,DA,DIC,X,DINUM,DLAYGO,X,Y
- . N PRCDA2,PRCA,PRCB,DIE,DR,PRCERR,PRCRFQ
- . D NOW^%DTC Q:%<$P($G(^PRC(444,PRCDA,0)),U,3)
- . S PRCRFQ=$P($G(^PRC(444,PRCDA,0)),U),PRCQDT=$P($G(^(0)),U,3),PRCDUZ=$P($G(^(0)),U,4)
- . S ^TMP($J,"PRCHQ10",PRCDUZ)=""
- . S PRCQDT=+$E(PRCQDT,4,5)_"/"_(+$E(PRCQDT,6,7))_"/"_$E(PRCQDT,2,3)_$S($P(PRCQDT,".",2)]"":"@"_$E($P(PRCQDT,".",2)_"000000",1,4),1:"")
- . D CLOSE
- . S PRCLCNT=PRCLCNT+1,^TMP($J,"RFQ",PRCLCNT)=" "_PRCRFQ_" Quote Due: "_PRCQDT_" CO: "_$P($G(^VA(200,PRCDUZ,0)),U)
- I PRCLCNT>3 D
- . N XMY,XMZ,XMTEXT,XMSUB,XMDUZ
- . S XMTEXT="^TMP($J,""RFQ"",",XMSUB="RFQs Closed by Scheduled Option"
- . S PRCDUZ=""
- . F S PRCDUZ=$O(^TMP($J,"PRCHQ10",PRCDUZ)) Q:PRCDUZ="" S XMY(PRCDUZ)=""
- . S XMY("G.PRCHQ RFQ")="",XMDUZ="BACKGROUND RFQ CLOSE OPTION"
- . D ^XMD K XMZ,XMY,XMTEXT,XMSUB
- K ^TMP($J,"RFQ"),^TMP($J,"PRCHQ10")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ10 4559 printed Feb 18, 2025@23:35:54 Page 2
- PRCHQ10 ;(WASH IRMFO)/LKG-RFQ CLOSE ;8/6/96 20:42
- +1 ;;5.1;IFCAP;;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;Close RFQ and Transmit 864 Text Message notification
- +1 KILL DIC
- SET DIC="^PRC(444,"
- SET DIC(0)="AEMQ"
- SET DIC("S")="I "";2;""[("";""_$P(^(0),U,8)_"";"")"
- +2 SET DIC("A")="Select RFQ to Close: "
- DO ^DIC
- KILL DIC
- +3 if +Y<1!$DATA(DTOUT)!$DATA(DUOUT)
- GOTO EX1
- +4 SET PRCDA=+Y
- SET PRCRFQ=$PIECE(Y,U,2)
- +5 LOCK +^PRC(444,PRCDA):5
- IF '$TEST
- WRITE !,"This RFQ entry is in use, please try later!"
- GOTO EN
- +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 Closure."
- +8 DO ^DIR
- KILL DIR
- +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")="NO"
- +13 SET DIR("?")="Answer 'NO' to abort the Closure."
- +14 DO ^DIR
- KILL DIR
- End DoDot:1
- if Y'=1
- GOTO EX1
- +15 SET PRCMSG=""
- DO ESIG^PRCUESIG(DUZ,.PRCMSG)
- if PRCMSG'=1
- GOTO EX1
- +16 SET PRCDUZ=DUZ
- DO CLOSE
- +17 GOTO EN
- CLOSE ;Close RFQ to further quotes
- +1 DO NOW^%DTC
- SET PRCDT=%
- KILL %
- +2 if $PIECE($GET(^PRC(444,PRCDA,1)),U,11)=""
- GOTO STATUS
- +3 SET PRCX=$GET(^PRC(444,PRCDA,1))
- SET PRCMSGN=$PIECE(PRCX,U,5)+1
- SET PRCOUTN=$PIECE(PRCX,U,6)+1
- +4 KILL DD,DO
- SET DA(1)=PRCDA
- SET DIC="^PRC(444,DA(1),7,"
- SET DIC(0)="L"
- +5 SET DIC("P")=$PIECE(^DD(444,21,0),U,2)
- SET X=PRCMSGN
- SET DINUM=PRCMSGN
- SET DLAYGO=444.021
- +6 DO FILE^DICN
- KILL DIC,DINUM,DLAYGO
- +7 IF Y<1
- if '$DATA(ZTQUEUED)
- WRITE !,"No 864 Text Message has been entered!"
- LOCK -^PRC(444,PRCDA)
- DO EX1
- QUIT
- +8 SET PRCDA2=+Y
- +9 SET $PIECE(^PRC(444,PRCDA,1),U,5,6)=PRCMSGN_U_PRCOUTN
- +10 KILL ^UTILITY("DIQ1",$JOB)
- SET DA=PRCDUZ
- SET DIC=200
- SET DR=".01;.135"
- DO EN^DIQ1
- +11 SET PRCA=^UTILITY("DIQ1",$JOB,200,DA,.01)
- SET PRCB=^(.135)
- KILL ^UTILITY("DIQ1",$JOB)
- +12 SET DA=PRCDA2
- SET DA(1)=PRCDA
- SET DIE="^PRC(444,DA(1),7,"
- +13 SET DR="1////O;4///^S X=PRCOUTN;5///NOW;6///NOW;7///^S X=PRCA"
- DO ^DIE
- +14 IF PRCB]""
- SET DR="8///^S X=PRCB"
- DO ^DIE
- +15 SET PRCA=$PIECE($GET(^PRC(444,PRCDA,1)),U,8)
- IF PRCA]""
- SET DR="12////^S X=PRCA"
- DO ^DIE
- +16 SET PRCX="** RFQ Closure Notification **"
- SET DR="9///^S X=PRCX"
- DO ^DIE
- +17 SET DR="13////^S X=PRCDUZ;13.1////^S X=PRCDT"
- DO ^DIE
- +18 KILL DIE,DR,DA,PRCA,PRCB,PRCX,PRCMSGN,PRCOUTN
- +19 IF $PIECE($GET(^PRC(444,PRCDA,5,0)),U,4)>0
- Begin DoDot:1
- +20 NEW PRCX,PRCY,PRCDA3
- +21 SET PRCX=0
- SET PRCDA3=0
- +22 FOR
- SET PRCX=$ORDER(^PRC(444,PRCDA,5,PRCX))
- if PRCX'?1.N
- QUIT
- Begin DoDot:2
- +23 SET PRCY=$GET(^PRC(444,PRCDA,5,PRCX,0))
- if PRCY=""
- QUIT
- +24 if $PIECE(PRCY,U,2)'="e"&($PIECE(PRCY,U,2)'="b")
- QUIT
- SET PRCY=$PIECE(PRCY,U)
- if PRCY=""
- QUIT
- +25 SET PRCDA3=PRCDA3+1
- SET ^PRC(444,PRCDA,7,PRCDA2,3,PRCDA3,0)=PRCY
- +26 SET ^PRC(444,PRCDA,7,PRCDA2,3,"B",PRCY,PRCDA3)=""
- End DoDot:2
- +27 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
- +28 SET ^PRC(444,PRCDA,7,PRCDA2,2,1,0)="This is to notify you that RFQ #: "_PRCRFQ_" has "
- +29 SET ^PRC(444,PRCDA,7,PRCDA2,2,2,0)="been closed to further quotes."
- +30 SET ^PRC(444,PRCDA,7,PRCDA2,2,0)="^^2^2^"_$PIECE(PRCDT,".")
- +31 KILL PRCERR
- +32 DO TRANS864^PRCHQ4A
- +33 IF $GET(PRCERR)
- IF '$DATA(ZTQUEUED)
- DO EN^DDIOL("Electronic Transmission Aborted!")
- +34 KILL PRCDA2,PRCERR
- STATUS SET DIE=444
- SET DA=PRCDA
- SET DR="7////3;20.7////^S X=PRCDUZ;20.8////^S X=PRCDT"
- +1 DO ^DIE
- KILL DIE,DR,PRCDT
- +2 LOCK -^PRC(444,PRCDA)
- +3 QUIT
- EX1 if $DATA(PRCDA)
- LOCK -^PRC(444,PRCDA)
- KILL PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +1 KILL DA,PRCX,PRCMSGN,PRCOUTN,DA,DD,DO,PRCDT,PRCMSG,PRCDUZ
- +2 QUIT
- BKGND ;Automatic closure upon reaching Quote Due Date. This code
- +1 ;;can be invoked as a Scheduled Option
- +2 KILL ^TMP($JOB,"RFQ"),^TMP($JOB,"PRCHQ10")
- if '$DATA(U)!'$DATA(DUZ)
- DO DT^DICRW
- +3 NEW PRCDA,PRCDUZ,PRCLCNT,PRCQDT
- +4 SET ^TMP($JOB,"RFQ",1)="The following RFQs have been closed automatically as the Quote Due Date"
- +5 SET ^TMP($JOB,"RFQ",2)="has been reached."
- SET ^TMP($JOB,"RFQ",3)=" "
- +6 SET PRCDA=0
- SET PRCLCNT=3
- +7 SET PRCDA=0
- +8 FOR
- SET PRCDA=$ORDER(^PRC(444,"AH",2,PRCDA))
- if PRCDA=""
- QUIT
- Begin DoDot:1
- +9 NEW PRCDT,PRCX,PRCMSGN,PRCOUTN,DD,DO,DA,DIC,X,DINUM,DLAYGO,X,Y
- +10 NEW PRCDA2,PRCA,PRCB,DIE,DR,PRCERR,PRCRFQ
- +11 DO NOW^%DTC
- if %<$PIECE($GET(^PRC(444,PRCDA,0)),U,3)
- QUIT
- +12 SET PRCRFQ=$PIECE($GET(^PRC(444,PRCDA,0)),U)
- SET PRCQDT=$PIECE($GET(^(0)),U,3)
- SET PRCDUZ=$PIECE($GET(^(0)),U,4)
- +13 SET ^TMP($JOB,"PRCHQ10",PRCDUZ)=""
- +14 SET PRCQDT=+$EXTRACT(PRCQDT,4,5)_"/"_(+$EXTRACT(PRCQDT,6,7))_"/"_$EXTRACT(PRCQDT,2,3)_$SELECT($PIECE(PRCQDT,".",2)]"":"@"_$EXTRACT($PIECE(PRCQDT,".",2)_"000000",1,4),1:"")
- +15 DO CLOSE
- +16 SET PRCLCNT=PRCLCNT+1
- SET ^TMP($JOB,"RFQ",PRCLCNT)=" "_PRCRFQ_" Quote Due: "_PRCQDT_" CO: "_$PIECE($GET(^VA(200,PRCDUZ,0)),U)
- End DoDot:1
- +17 IF PRCLCNT>3
- Begin DoDot:1
- +18 NEW XMY,XMZ,XMTEXT,XMSUB,XMDUZ
- +19 SET XMTEXT="^TMP($J,""RFQ"","
- SET XMSUB="RFQs Closed by Scheduled Option"
- +20 SET PRCDUZ=""
- +21 FOR
- SET PRCDUZ=$ORDER(^TMP($JOB,"PRCHQ10",PRCDUZ))
- if PRCDUZ=""
- QUIT
- SET XMY(PRCDUZ)=""
- +22 SET XMY("G.PRCHQ RFQ")=""
- SET XMDUZ="BACKGROUND RFQ CLOSE OPTION"
- +23 DO ^XMD
- KILL XMZ,XMY,XMTEXT,XMSUB
- End DoDot:1
- +24 KILL ^TMP($JOB,"RFQ"),^TMP($JOB,"PRCHQ10")
- +25 QUIT