- 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 Jan 18, 2025@03:11:05 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