Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHQ8

PRCHQ8.m

Go to the documentation of this file.
  1. PRCHQ8 ;(WASH IRMFO)/LKG-RFQ RETRANSMIT ;8/6/96 20:59
  1. ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. RETRANS ;Retransmit 840 Transaction for RFQ
  1. K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";2;""[("";""_$P(^(0),U,8)_"";"")"
  1. S DIC("A")="Select RFQ to retransmit: " D ^DIC K DIC
  1. G EX1:+Y<1!$D(DTOUT)!$D(DUOUT)
  1. S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
  1. L +^PRC(444,PRCDA):5 E W !,"This RFQ is in use, please try later!" G RETRANS
  1. K DIR S DIR(0)="YA",DIR("A")="Do you wish to review a synopsis of this RFQ? "
  1. S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to retransmission."
  1. D ^DIR K DIR
  1. I Y=1 D G:Y'=1 EX1
  1. . N L,DIC,DR,FLDS,BY,FR,TO,IOP S DIC=444,BY=.01,(FR,TO)=PRCRFQ,L=0,IOP="HOME"
  1. . S FLDS="[PRCHQ RFQ SYNOPSIS]" D EN1^DIP K DIC,FLDS,BY,FR,DR,L
  1. . S DIR(0)="YA",DIR("A")="Is this the correct RFQ? ",DIR("B")="NO"
  1. . S DIR("?")="Answer 'NO' to abort the retransmission."
  1. . D ^DIR K DIR
  1. K PRCERR S PRCTYPE="00"
  1. D TRANS840^PRCHQ4A(PRCTYPE) D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
  1. L -^PRC(444,PRCDA) K PRCERR
  1. G RETRANS
  1. EX1 L:$D(PRCDA) -^PRC(444,PRCDA) K PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCTYPE
  1. Q
  1. RSND864 ;Retransmit 864 Text Message
  1. K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";0;5;""'[("";""_$P(^(0),U,8)_"";"")"
  1. S DIC("A")="Select 864's RFQ #: " D ^DIC K DIC
  1. G EX2:+Y<1!$D(DTOUT)!$D(DUOUT)
  1. S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
  1. L +^PRC(444,PRCDA):5 E W !,"This RFQ is in use, please try later!" G RSND864
  1. K DIR S DIR(0)="YA",DIR("A")="Do you wish to view a synopsis of this RFQ? "
  1. S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to selecting the message."
  1. D ^DIR K DIR
  1. I Y=1 D G:Y'=1 EX2:$D(DTOUT)!$D(DIROUT)!$D(DIRUT),RSND864
  1. . N L,DIC,DR,FLDS,BY,FR,TO,IOP S DIC=444,BY=.01,(FR,TO)=PRCRFQ,L=0,IOP="HOME"
  1. . S FLDS="[PRCHQ RFQ SYNOPSIS]" D EN1^DIP K DIC,FLDS,BY,FR,DR,L
  1. . S DIR(0)="YA",DIR("A")="Is this the correct RFQ? ",DIR("B")="NO"
  1. . S DIR("?")="Answer 'NO' to return to the prompt for RFQ #."
  1. . D ^DIR K DIR
  1. . L:Y'=1 -^PRC(444,PRCDA)
  1. A K DIC S DA(1)=PRCDA,DIC="^PRC(444,DA(1),7,",DIC("S")="I $P(^(0),U,2)=""O"""
  1. 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"
  1. S DIC(0)="AEMQ",DIC("A")="Select 864 Text Message: "
  1. D ^DIC K DIC,DA
  1. G EX2:$D(DTOUT)!$D(DUOUT),RSND864:+Y<1
  1. S PRCDA2=+Y,PRCMSGN=$P(Y,U,2)
  1. K DIR S DIR(0)="YA",DIR("A")="Do you wish to view this text message? "
  1. S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view this message before transmission."
  1. D ^DIR K DIR
  1. I Y=1 D G EX2:$D(DIROUT)!$D(DIRUT),A:+Y<1
  1. . N L,DIC,DR,FLDS,BY,FR,TO,IOP,DHD S DIC=444,L=0,BY="[PRCHQ RFQ MESSAGE SORT]"
  1. . S FLDS="[PRCHQ RFQ MESSAGES 2]",(FR,TO)=PRCRFQ_","_PRCMSGN,DHD="@",IOP="HOME"
  1. . D EN1^DIP K DIC,FLDS,BY,FR,TO,DHD,L
  1. . K DIR S DIR(0)="YA",DIR("A")="Is this the correct Message? "
  1. . S DIR("B")="NO",DIR("?")="Answer 'NO' to abort the retransmission."
  1. . D ^DIR K DIR
  1. . L:Y'=1 -^PRC(444,PRCDA)
  1. K PRCERR
  1. D TRANS864^PRCHQ4A D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
  1. L -^PRC(444,PRCDA) K PRCERR
  1. G A
  1. EX2 L:$D(PRCDA) -^PRC(444,PRCDA)
  1. K PRCDA,PRCDA2,PRCRFQ,PRCMSGN,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,DA
  1. Q