source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHQ8.m@ 1297

Last change on this file since 1297 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1PRCHQ8 ;(WASH IRMFO)/LKG-RFQ RETRANSMIT ;8/6/96 20:59
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4RETRANS ;Retransmit 840 Transaction for RFQ
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 retransmit: " 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 is in use, please try later!" G RETRANS
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 retransmission."
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 retransmission."
18 . D ^DIR K DIR
19 K PRCERR S PRCTYPE="00"
20 D TRANS840^PRCHQ4A(PRCTYPE) D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
21 L -^PRC(444,PRCDA) K PRCERR
22 G RETRANS
23EX1 L:$D(PRCDA) -^PRC(444,PRCDA) K PRCDA,PRCRFQ,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,PRCTYPE
24 Q
25RSND864 ;Retransmit 864 Text Message
26 K DIC S DIC="^PRC(444,",DIC(0)="AEMQ",DIC("S")="I "";0;5;""'[("";""_$P(^(0),U,8)_"";"")"
27 S DIC("A")="Select 864's RFQ #: " D ^DIC K DIC
28 G EX2:+Y<1!$D(DTOUT)!$D(DUOUT)
29 S PRCDA=+Y,PRCRFQ=$P(Y,U,2)
30 L +^PRC(444,PRCDA):5 E W !,"This RFQ is in use, please try later!" G RSND864
31 K DIR S DIR(0)="YA",DIR("A")="Do you wish to view a synopsis of this RFQ? "
32 S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view the RFQ prior to selecting the message."
33 D ^DIR K DIR
34 I Y=1 D G:Y'=1 EX2:$D(DTOUT)!$D(DIROUT)!$D(DIRUT),RSND864
35 . N L,DIC,DR,FLDS,BY,FR,TO,IOP S DIC=444,BY=.01,(FR,TO)=PRCRFQ,L=0,IOP="HOME"
36 . S FLDS="[PRCHQ RFQ SYNOPSIS]" D EN1^DIP K DIC,FLDS,BY,FR,DR,L
37 . S DIR(0)="YA",DIR("A")="Is this the correct RFQ? ",DIR("B")="NO"
38 . S DIR("?")="Answer 'NO' to return to the prompt for RFQ #."
39 . D ^DIR K DIR
40 . L:Y'=1 -^PRC(444,PRCDA)
41A K DIC S DA(1)=PRCDA,DIC="^PRC(444,DA(1),7,",DIC("S")="I $P(^(0),U,2)=""O"""
42 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"
43 S DIC(0)="AEMQ",DIC("A")="Select 864 Text Message: "
44 D ^DIC K DIC,DA
45 G EX2:$D(DTOUT)!$D(DUOUT),RSND864:+Y<1
46 S PRCDA2=+Y,PRCMSGN=$P(Y,U,2)
47 K DIR S DIR(0)="YA",DIR("A")="Do you wish to view this text message? "
48 S DIR("B")="YES",DIR("?")="Answer 'YES' if you wish to view this message before transmission."
49 D ^DIR K DIR
50 I Y=1 D G EX2:$D(DIROUT)!$D(DIRUT),A:+Y<1
51 . N L,DIC,DR,FLDS,BY,FR,TO,IOP,DHD S DIC=444,L=0,BY="[PRCHQ RFQ MESSAGE SORT]"
52 . S FLDS="[PRCHQ RFQ MESSAGES 2]",(FR,TO)=PRCRFQ_","_PRCMSGN,DHD="@",IOP="HOME"
53 . D EN1^DIP K DIC,FLDS,BY,FR,TO,DHD,L
54 . K DIR S DIR(0)="YA",DIR("A")="Is this the correct Message? "
55 . S DIR("B")="NO",DIR("?")="Answer 'NO' to abort the retransmission."
56 . D ^DIR K DIR
57 . L:Y'=1 -^PRC(444,PRCDA)
58 K PRCERR
59 D TRANS864^PRCHQ4A D:$G(PRCERR) EN^DDIOL("Electronic Transmission Aborted!")
60 L -^PRC(444,PRCDA) K PRCERR
61 G A
62EX2 L:$D(PRCDA) -^PRC(444,PRCDA)
63 K PRCDA,PRCDA2,PRCRFQ,PRCMSGN,DTOUT,DUOUT,DIRUT,DIROUT,X,Y,DA
64 Q
Note: See TracBrowser for help on using the repository browser.