| [613] | 1 | PRCHQ10 ;(WASH IRMFO)/LKG-RFQ CLOSE ;8/6/96 20:42
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | EN ;Close RFQ and Transmit 864 Text Message notification
|
|---|
| 5 | K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";2;""[("";""_$P(^(0),U,8)_"";"")"
|
|---|
| 6 | S DIC("A")="Select RFQ to Close: " D ^DIC K DIC
|
|---|
| 7 | G EX1:+Y<1!$D(DTOUT)!$D(DUOUT)
|
|---|
| 8 | S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
|
|---|
| 9 | L +^PRC(444,PRCDA):5 E W !,"This RFQ entry is in use, please try later!" G EN
|
|---|
| 10 | K DIR S DIR(0)="YA",DIR("A")="Do you wish to review a synopsis of this RFQ? "
|
|---|
| 11 | S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to Closure."
|
|---|
| 12 | D ^DIR K DIR
|
|---|
| 13 | I Y=1 D G:Y'=1 EX1
|
|---|
| 14 | . N L,DIC,DR,FLDS,BY,FR,TO,IOP S DIC=444,BY=.01,(FR,TO)=PRCRFQ,L=0,IOP="HOME"
|
|---|
| 15 | . S FLDS="[PRCHQ RFQ SYNOPSIS]" D EN1^DIP K DIC,FLDS,BY,FR,DR,L
|
|---|
| 16 | . S DIR(0)="YA",DIR("A")="Is this the correct RFQ? ",DIR("B")="NO"
|
|---|
| 17 | . S DIR("?")="Answer 'NO' to abort the Closure."
|
|---|
| 18 | . D ^DIR K DIR
|
|---|
| 19 | S PRCMSG="" D ESIG^PRCUESIG(DUZ,.PRCMSG) G:PRCMSG'=1 EX1
|
|---|
| 20 | S PRCDUZ=DUZ D CLOSE
|
|---|
| 21 | G EN
|
|---|
| 22 | CLOSE ;Close RFQ to further quotes
|
|---|
| 23 | D NOW^%DTC S PRCDT=% K %
|
|---|
| 24 | G:$P($G(^PRC(444,PRCDA,1)),U,11)="" STATUS
|
|---|
| 25 | S PRCX=$G(^PRC(444,PRCDA,1)),PRCMSGN=$P(PRCX,U,5)+1,PRCOUTN=$P(PRCX,U,6)+1
|
|---|
| 26 | K DD,DO S DA(1)=PRCDA,DIC="^PRC(444,DA(1),7,",DIC(0)="L"
|
|---|
| 27 | S DIC("P")=$P(^DD(444,21,0),U,2),X=PRCMSGN,DINUM=PRCMSGN,DLAYGO=444.021
|
|---|
| 28 | D FILE^DICN K DIC,DINUM,DLAYGO
|
|---|
| 29 | I Y<1 W:'$D(ZTQUEUED) !,"No 864 Text Message has been entered!" L -^PRC(444,PRCDA) D EX1 Q
|
|---|
| 30 | S PRCDA2=+Y
|
|---|
| 31 | S $P(^PRC(444,PRCDA,1),U,5,6)=PRCMSGN_U_PRCOUTN
|
|---|
| 32 | K ^UTILITY("DIQ1",$J) S DA=PRCDUZ,DIC=200,DR=".01;.135" D EN^DIQ1
|
|---|
| 33 | S PRCA=^UTILITY("DIQ1",$J,200,DA,.01),PRCB=^(.135) K ^UTILITY("DIQ1",$J)
|
|---|
| 34 | S DA=PRCDA2,DA(1)=PRCDA,DIE="^PRC(444,DA(1),7,"
|
|---|
| 35 | S DR="1////O;4///^S X=PRCOUTN;5///NOW;6///NOW;7///^S X=PRCA" D ^DIE
|
|---|
| 36 | I PRCB]"" S DR="8///^S X=PRCB" D ^DIE
|
|---|
| 37 | S PRCA=$P($G(^PRC(444,PRCDA,1)),U,8) I PRCA]"" S DR="12////^S X=PRCA" D ^DIE
|
|---|
| 38 | S PRCX="** RFQ Closure Notification **",DR="9///^S X=PRCX" D ^DIE
|
|---|
| 39 | S DR="13////^S X=PRCDUZ;13.1////^S X=PRCDT" D ^DIE
|
|---|
| 40 | K DIE,DR,DA,PRCA,PRCB,PRCX,PRCMSGN,PRCOUTN
|
|---|
| 41 | I $P($G(^PRC(444,PRCDA,5,0)),U,4)>0 D
|
|---|
| 42 | . N PRCX,PRCY,PRCDA3
|
|---|
| 43 | . S PRCX=0,PRCDA3=0
|
|---|
| 44 | . F S PRCX=$O(^PRC(444,PRCDA,5,PRCX)) Q:PRCX'?1.N D
|
|---|
| 45 | . . S PRCY=$G(^PRC(444,PRCDA,5,PRCX,0)) Q:PRCY=""
|
|---|
| 46 | . . Q:$P(PRCY,U,2)'="e"&($P(PRCY,U,2)'="b") S PRCY=$P(PRCY,U) Q:PRCY=""
|
|---|
| 47 | . . S PRCDA3=PRCDA3+1,^PRC(444,PRCDA,7,PRCDA2,3,PRCDA3,0)=PRCY
|
|---|
| 48 | . . S ^PRC(444,PRCDA,7,PRCDA2,3,"B",PRCY,PRCDA3)=""
|
|---|
| 49 | . S:PRCDA3>0 ^PRC(444,PRCDA,7,PRCDA2,3,0)=U_$P(^DD(444.021,11,0),U,2)_U_PRCDA3_U_PRCDA3
|
|---|
| 50 | S ^PRC(444,PRCDA,7,PRCDA2,2,1,0)="This is to notify you that RFQ #: "_PRCRFQ_" has "
|
|---|
| 51 | S ^PRC(444,PRCDA,7,PRCDA2,2,2,0)="been closed to further quotes."
|
|---|
| 52 | S ^PRC(444,PRCDA,7,PRCDA2,2,0)="^^2^2^"_$P(PRCDT,".")
|
|---|
| 53 | K PRCERR
|
|---|
| 54 | D TRANS864^PRCHQ4A
|
|---|
| 55 | I $G(PRCERR),'$D(ZTQUEUED) D EN^DDIOL("Electronic Transmission Aborted!")
|
|---|
| 56 | K PRCDA2,PRCERR
|
|---|
| 57 | STATUS S DIE=444,DA=PRCDA,DR="7////3;20.7////^S X=PRCDUZ;20.8////^S X=PRCDT"
|
|---|
| 58 | D ^DIE K DIE,DR,PRCDT
|
|---|
| 59 | L -^PRC(444,PRCDA)
|
|---|
| 60 | Q
|
|---|
| 61 | EX1 L:$D(PRCDA) -^PRC(444,PRCDA) K PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 62 | K DA,PRCX,PRCMSGN,PRCOUTN,DA,DD,DO,PRCDT,PRCMSG,PRCDUZ
|
|---|
| 63 | Q
|
|---|
| 64 | BKGND ;Automatic closure upon reaching Quote Due Date. This code
|
|---|
| 65 | ;;can be invoked as a Scheduled Option
|
|---|
| 66 | K ^TMP($J,"RFQ"),^TMP($J,"PRCHQ10") D:'$D(U)!'$D(DUZ) DT^DICRW
|
|---|
| 67 | N PRCDA,PRCDUZ,PRCLCNT,PRCQDT
|
|---|
| 68 | S ^TMP($J,"RFQ",1)="The following RFQs have been closed automatically as the Quote Due Date"
|
|---|
| 69 | S ^TMP($J,"RFQ",2)="has been reached.",^TMP($J,"RFQ",3)=" "
|
|---|
| 70 | S PRCDA=0,PRCLCNT=3
|
|---|
| 71 | S PRCDA=0
|
|---|
| 72 | F S PRCDA=$O(^PRC(444,"AH",2,PRCDA)) Q:PRCDA="" D
|
|---|
| 73 | . N PRCDT,PRCX,PRCMSGN,PRCOUTN,DD,DO,DA,DIC,X,DINUM,DLAYGO,X,Y
|
|---|
| 74 | . N PRCDA2,PRCA,PRCB,DIE,DR,PRCERR,PRCRFQ
|
|---|
| 75 | . D NOW^%DTC Q:%<$P($G(^PRC(444,PRCDA,0)),U,3)
|
|---|
| 76 | . S PRCRFQ=$P($G(^PRC(444,PRCDA,0)),U),PRCQDT=$P($G(^(0)),U,3),PRCDUZ=$P($G(^(0)),U,4)
|
|---|
| 77 | . S ^TMP($J,"PRCHQ10",PRCDUZ)=""
|
|---|
| 78 | . 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:"")
|
|---|
| 79 | . D CLOSE
|
|---|
| 80 | . S PRCLCNT=PRCLCNT+1,^TMP($J,"RFQ",PRCLCNT)=" "_PRCRFQ_" Quote Due: "_PRCQDT_" CO: "_$P($G(^VA(200,PRCDUZ,0)),U)
|
|---|
| 81 | I PRCLCNT>3 D
|
|---|
| 82 | . N XMY,XMZ,XMTEXT,XMSUB,XMDUZ
|
|---|
| 83 | . S XMTEXT="^TMP($J,""RFQ"",",XMSUB="RFQs Closed by Scheduled Option"
|
|---|
| 84 | . S PRCDUZ=""
|
|---|
| 85 | . F S PRCDUZ=$O(^TMP($J,"PRCHQ10",PRCDUZ)) Q:PRCDUZ="" S XMY(PRCDUZ)=""
|
|---|
| 86 | . S XMY("G.PRCHQ RFQ")="",XMDUZ="BACKGROUND RFQ CLOSE OPTION"
|
|---|
| 87 | . D ^XMD K XMZ,XMY,XMTEXT,XMSUB
|
|---|
| 88 | K ^TMP($J,"RFQ"),^TMP($J,"PRCHQ10")
|
|---|
| 89 | Q
|
|---|
