PRCFACR5.m

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 ---PRCFACR5   1727     printed  Apr 09, 2024@21:03:43                                                                                                                                                                                                    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