PRCAKTP.m

PRCAKTP ;WASH-ISC@ALTOONA,PA/CMS-AR PURGE TEMP ARCHIVE FILE ;6/4/93  11:05 AM

V ;;4.5;Accounts Receivable;;Mar 20, 1995

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 NEW STAT,%

 I $P($G(^PRCAK(430.8,0)),U,3)'>0 W !!,*7,"  The temporary storage file does not have data!",! G Q

 W !!,"This option will purge the data in the temporary storage file",!,"(AR Archive File 430.8).  Please coordinate the use of this option",!,"with IRM to make sure the PRCAK global is placed."

 S STAT=$O(^PRCA(430.3,"AC",114,0))

 I $O(^PRCA(430,"AC",STAT,0)) W !!,*7,"WARNING:  There are records remaining in the PENDING ARCHIVE status.",!,?10,"Remember to build this file again later."

 W !!,"Ready to purge 'NOW'" S %=2 D YN^DICN I %'=1 G Q

 D PUR

 W !!,?5,"Temporay Storage File is empty."

Q Q

PUR ;

 N TGLO

 L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Kill Temporary Storage File") Q

 S TGLO=^PRCAK(430.8,0) K ^PRCAK(430.8) S ^PRCAK(430.8,0)=$P(TGLO,"^",1,2)_"^"

 L -^PRCAK("PRCAK")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCAKTP   1008     printed  Feb 18, 2025@23:06:39                                                                                                                                                                                                     Page 2

PRCAKTP   ;WASH-ISC@ALTOONA,PA/CMS-AR PURGE TEMP ARCHIVE FILE ;6/4/93  11:05 AM

V         ;;4.5;Accounts Receivable;;Mar 20, 1995

 +1       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +2        NEW STAT,%

 +3        IF $PIECE($GET(^PRCAK(430.8,0)),U,3)'>0

               WRITE !!,*7,"  The temporary storage file does not have data!",!

               GOTO Q

 +4        WRITE !!,"This option will purge the data in the temporary storage file",!,"(AR Archive File 430.8).  Please coordinate the use of this option",!,"with IRM to make sure the PRCAK global is placed."

 +5        SET STAT=$ORDER(^PRCA(430.3,"AC",114,0))

 +6        IF $ORDER(^PRCA(430,"AC",STAT,0))

               WRITE !!,*7,"WARNING:  There are records remaining in the PENDING ARCHIVE status.",!,?10,"Remember to build this file again later."

 +7        WRITE !!,"Ready to purge 'NOW'"

           SET %=2

           DO YN^DICN

           IF %'=1

               GOTO Q

 +8        DO PUR

 +9        WRITE !!,?5,"Temporay Storage File is empty."

Q          QUIT 

PUR       ;

 +1        NEW TGLO

 +2        LOCK +^PRCAK("PRCAK"):1

           IF '$TEST

               DO BUSY^PRCAKS("Kill Temporary Storage File")

               QUIT 

 +3        SET TGLO=^PRCAK(430.8,0)

           KILL ^PRCAK(430.8)

           SET ^PRCAK(430.8,0)=$PIECE(TGLO,"^",1,2)_"^"

 +4        LOCK -^PRCAK("PRCAK")

 +5        QUIT