PRCHQ8 ;(WASH IRMFO)/LKG-RFQ RETRANSMIT ;8/6/96 20:59
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
RETRANS ;Retransmit 840 Transaction for RFQ
K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";2;""[("";""_$P(^(0),U,8)_"";"")"
S DIC("A")="Select RFQ to retransmit: " 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 is in use, please try later!" G RETRANS
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 retransmission."
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 retransmission."
. D ^DIR K DIR
K PRCERR S PRCTYPE="00"
D TRANS840^PRCHQ4A(PRCTYPE) D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
L -^PRC(444,PRCDA) K PRCERR
G RETRANS
EX1 L:$D(PRCDA) -^PRC(444,PRCDA) K PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCTYPE
Q
RSND864 ;Retransmit 864 Text Message
K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";0;5;""'[("";""_$P(^(0),U,8)_"";"")"
S DIC("A")="Select 864's RFQ #: " D ^DIC K DIC
G EX2:+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 RSND864
K DIR S DIR(0)="YA",DIR("A")="Do you wish to view a synopsis of this RFQ? "
S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to selecting the message."
D ^DIR K DIR
I Y=1 D G:Y'=1 EX2:$D(DTOUT)!$D(DIROUT)!$D(DIRUT),RSND864
. 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 return to the prompt for RFQ #."
. D ^DIR K DIR
. L:Y'=1 -^PRC(444,PRCDA)
A K DIC S DA(1)=PRCDA,DIC="^PRC(444,DA(1),7,",DIC("S")="I $P(^(0),U,2)=""O"""
S DIC("W")="S PRCZ=$P(^(0),U,6) W "" Created: "",+$E(PRCZ,4,5),""/"",+$E(PRCZ,6,7),""/"",$E(PRCZ,2,3),"" "",$E($P($G(^(1)),U),1,40) K PRCZ"
S DIC(0)="AEMQ",DIC("A")="Select 864 Text Message: "
D ^DIC K DIC,DA
G EX2:$D(DTOUT)!$D(DUOUT),RSND864:+Y<1
S PRCDA2=+Y,PRCMSGN=$P(Y,U,2)
K DIR S DIR(0)="YA",DIR("A")="Do you wish to view this text message? "
S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view this message before transmission."
D ^DIR K DIR
I Y=1 D G EX2:$D(DIROUT)!$D(DIRUT),A:+Y<1
. N L,DIC,DR,FLDS,BY,FR,TO,IOP,DHD S DIC=444,L=0,BY="[PRCHQ RFQ MESSAGE SORT]"
. S FLDS="[PRCHQ RFQ MESSAGES 2]",(FR,TO)=PRCRFQ_","_PRCMSGN,DHD="@",IOP="HOME"
. D EN1^DIP K DIC,FLDS,BY,FR,TO,DHD,L
. K DIR S DIR(0)="YA",DIR("A")="Is this the correct Message? "
. S DIR("B")="NO",DIR("?")="Answer 'NO' to abort the retransmission."
. D ^DIR K DIR
. L:Y'=1 -^PRC(444,PRCDA)
K PRCERR
D TRANS864^PRCHQ4A D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
L -^PRC(444,PRCDA) K PRCERR
G A
EX2 L:$D(PRCDA) -^PRC(444,PRCDA)
K PRCDA,PRCDA2,PRCRFQ,PRCMSGN,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,DA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHQ8 3348 printed Apr 09, 2024@21:10:17 Page 2
PRCHQ8 ;(WASH IRMFO)/LKG-RFQ RETRANSMIT ;8/6/96 20:59
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
RETRANS ;Retransmit 840 Transaction for RFQ
+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 retransmit: "
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 is in use, please try later!"
GOTO RETRANS
+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 retransmission."
+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 retransmission."
+14 DO ^DIR
KILL DIR
End DoDot:1
if Y'=1
GOTO EX1
+15 KILL PRCERR
SET PRCTYPE="00"
+16 DO TRANS840^PRCHQ4A(PRCTYPE)
if $GET(PRCERR)
DO EN^DDIOL("Electronic Transmission Aborted!")
+17 LOCK -^PRC(444,PRCDA)
KILL PRCERR
+18 GOTO RETRANS
EX1 if $DATA(PRCDA)
LOCK -^PRC(444,PRCDA)
KILL PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCTYPE
+1 QUIT
RSND864 ;Retransmit 864 Text Message
+1 KILL DIC
SET DIC="^PRC(444,"
SET DIC(0)="AEMQ"
SET DIC("S")="I "";0;5;""'[("";""_$P(^(0),U,8)_"";"")"
+2 SET DIC("A")="Select 864's RFQ #: "
DO ^DIC
KILL DIC
+3 if +Y<1!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EX2
+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 RSND864
+6 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to view a synopsis of this RFQ? "
+7 SET DIR("B")="YES"
SET DIR("?")="Answer 'YES' if you wish to view the RFQ prior to selecting the message."
+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 return to the prompt for RFQ #."
+14 DO ^DIR
KILL DIR
+15 if Y'=1
LOCK -^PRC(444,PRCDA)
End DoDot:1
if Y'=1
if $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DIRUT)
GOTO EX2
GOTO RSND864
A KILL DIC
SET DA(1)=PRCDA
SET DIC="^PRC(444,DA(1),7,"
SET DIC("S")="I $P(^(0),U,2)=""O"""
+1 SET DIC("W")="S PRCZ=$P(^(0),U,6) W "" Created: "",+$E(PRCZ,4,5),""/"",+$E(PRCZ,6,7),""/"",$E(PRCZ,2,3),"" "",$E($P($G(^(1)),U),1,40) K PRCZ"
+2 SET DIC(0)="AEMQ"
SET DIC("A")="Select 864 Text Message: "
+3 DO ^DIC
KILL DIC,DA
+4 if $DATA(DTOUT)!$DATA(DUOUT)
GOTO EX2
if +Y<1
GOTO RSND864
+5 SET PRCDA2=+Y
SET PRCMSGN=$PIECE(Y,U,2)
+6 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Do you wish to view this text message? "
+7 SET DIR("B")="YES"
SET DIR("?")="Answer 'YES' if you wish to view this message before transmission."
+8 DO ^DIR
KILL DIR
+9 IF Y=1
Begin DoDot:1
+10 NEW L,DIC,DR,FLDS,BY,FR,TO,IOP,DHD
SET DIC=444
SET L=0
SET BY="[PRCHQ RFQ MESSAGE SORT]"
+11 SET FLDS="[PRCHQ RFQ MESSAGES 2]"
SET (FR,TO)=PRCRFQ_","_PRCMSGN
SET DHD="@"
SET IOP="HOME"
+12 DO EN1^DIP
KILL DIC,FLDS,BY,FR,TO,DHD,L
+13 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Is this the correct Message? "
+14 SET DIR("B")="NO"
SET DIR("?")="Answer 'NO' to abort the retransmission."
+15 DO ^DIR
KILL DIR
+16 if Y'=1
LOCK -^PRC(444,PRCDA)
End DoDot:1
if $DATA(DIROUT)!$DATA(DIRUT)
GOTO EX2
if +Y<1
GOTO A
+17 KILL PRCERR
+18 DO TRANS864^PRCHQ4A
if $GET(PRCERR)
DO EN^DDIOL("Electronic Transmission Aborted!")
+19 LOCK -^PRC(444,PRCDA)
KILL PRCERR
+20 GOTO A
EX2 if $DATA(PRCDA)
LOCK -^PRC(444,PRCDA)
+1 KILL PRCDA,PRCDA2,PRCRFQ,PRCMSGN,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,DA
+2 QUIT
