PRCFACR5 ;WISC@ALTOONA/CTB-RETRANSMIT CODE SHEETS TO AUSTIN ;2/19/93 08:17
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
OUT K %,N,I,%DT,%H,%Y,DIC,DIJ,ER,A,B,C,DQTIME,FAIL,POP,POK,PTR,PTRN,PBAT,PBATN,PFLAG,PRCFRT,X,X1,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,IOX,IOY,XMZ,Y Q
RT ;ENTRY POINT TO RETRANSMIT A BATCH
W !!,"This option is designed to RERELEASE a batch. You may not do original releases",!,"using this option."
S:'$D(PRCFASYS) PRCFASYS="FEEFENIRSCLICLM" S PRCF("X")="AS" D ^PRCFSITE G:'% OUT
S PRCF("X")="AS" D NOW^PRCFQ S PRCFKEY=%_"-"_DUZ
D ES^PRCFACR G:$D(FAIL) OUT K POK,^PRCF(421.2,"AD",PRCFKEY) S DIC("A")="Select Batch Number: " I $D(^PRCF(423,"AK",PRCFKEY)) D SET I %<0 W " <Option Aborted>",$C(7) G OUT
K ^PRCF(423,"AD",PRCFKEY)
RT1 S PRCFRT=3,DIC=421.2,DIC(0)="AEMQZ",DIC("S")="S XXX=^(0) I $P(XXX,U,4)]"""",$P(XXX,U,3)=""B"",PRCFASYS[$P(XXX,""-"",2)"
D ^DIC K DIC,XXX I Y<0,'$D(POK) S X=" <No Action Taken>*" D MSG^PRCFQ G OUT
G:Y<0 ^PRCFACR0 S PBAT=$P(Y,U,2),PBATN=+Y,^PRCF(421.2,"AD",PRCFKEY,PBATN)="",$P(^PRCF(421.2,PBATN,0),"^",15)=PRCFKEY
W !,$C(7) S %A="I will now RERELEASE batch "_PBAT_" to Austin.",%A(1)="ARE YOU SURE YOU WANT TO DO THIS",%B="",%=2 D ^PRCFYN G OUT:%<0 I %=2 S X=" <No Action Taken>*" D MSG^PRCFQ
I %=1 S X=" <Batch has been Rereleased to Austin>*" D MSG^PRCFQ W !
S POK="",DIC("A")="Select Next Batch Number: " G RT1
Q
SET ;
W $C(7),!!,"There appears to be Code Sheets transmitting at this time. Please try",!,"again in 30 minutes.",!!
S %A="Try later",%B="",%=1 D ^PRCFYN I %=1 S %=-1 Q
S %A="Do you want to overide transmission at this time",%B="",%=2 D ^PRCFYN I %'=1 S %=-1 Q
S %=1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCFACR5 1727 printed Dec 13, 2024@02:02:13 Page 2
PRCFACR5 ;WISC@ALTOONA/CTB-RETRANSMIT CODE SHEETS TO AUSTIN ;2/19/93 08:17
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
OUT KILL %,N,I,%DT,%H,%Y,DIC,DIJ,ER,A,B,C,DQTIME,FAIL,POP,POK,PTR,PTRN,PBAT,PBATN,PFLAG,PRCFRT,X,X1,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,IOX,IOY,XMZ,Y
QUIT
RT ;ENTRY POINT TO RETRANSMIT A BATCH
+1 WRITE !!,"This option is designed to RERELEASE a batch. You may not do original releases",!,"using this option."
+2 if '$DATA(PRCFASYS)
SET PRCFASYS="FEEFENIRSCLICLM"
SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO OUT
+3 SET PRCF("X")="AS"
DO NOW^PRCFQ
SET PRCFKEY=%_"-"_DUZ
+4 DO ES^PRCFACR
if $DATA(FAIL)
GOTO OUT
KILL POK,^PRCF(421.2,"AD",PRCFKEY)
SET DIC("A")="Select Batch Number: "
IF $DATA(^PRCF(423,"AK",PRCFKEY))
DO SET
IF %<0
WRITE " <Option Aborted>",$CHAR(7)
GOTO OUT
+5 KILL ^PRCF(423,"AD",PRCFKEY)
RT1 SET PRCFRT=3
SET DIC=421.2
SET DIC(0)="AEMQZ"
SET DIC("S")="S XXX=^(0) I $P(XXX,U,4)]"""",$P(XXX,U,3)=""B"",PRCFASYS[$P(XXX,""-"",2)"
+1 DO ^DIC
KILL DIC,XXX
IF Y<0
IF '$DATA(POK)
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
GOTO OUT
+2 if Y<0
GOTO ^PRCFACR0
SET PBAT=$PIECE(Y,U,2)
SET PBATN=+Y
SET ^PRCF(421.2,"AD",PRCFKEY,PBATN)=""
SET $PIECE(^PRCF(421.2,PBATN,0),"^",15)=PRCFKEY
+3 WRITE !,$CHAR(7)
SET %A="I will now RERELEASE batch "_PBAT_" to Austin."
SET %A(1)="ARE YOU SURE YOU WANT TO DO THIS"
SET %B=""
SET %=2
DO ^PRCFYN
if %<0
GOTO OUT
IF %=2
SET X=" <No Action Taken>*"
DO MSG^PRCFQ
+4 IF %=1
SET X=" <Batch has been Rereleased to Austin>*"
DO MSG^PRCFQ
WRITE !
+5 SET POK=""
SET DIC("A")="Select Next Batch Number: "
GOTO RT1
+6 QUIT
SET ;
+1 WRITE $CHAR(7),!!,"There appears to be Code Sheets transmitting at this time. Please try",!,"again in 30 minutes.",!!
+2 SET %A="Try later"
SET %B=""
SET %=1
DO ^PRCFYN
IF %=1
SET %=-1
QUIT
+3 SET %A="Do you want to overide transmission at this time"
SET %B=""
SET %=2
DO ^PRCFYN
IF %'=1
SET %=-1
QUIT
+4 SET %=1
QUIT
