| 1 | PRCAKTP ;WASH-ISC@ALTOONA,PA/CMS-AR PURGE TEMP ARCHIVE FILE ;6/4/93  11:05 AM
 | 
|---|
| 2 | V ;;4.5;Accounts Receivable;;Mar 20, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  NEW STAT,%
 | 
|---|
| 5 |  I $P($G(^PRCAK(430.8,0)),U,3)'>0 W !!,*7,"  The temporary storage file does not have data!",! G Q
 | 
|---|
| 6 |  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."
 | 
|---|
| 7 |  S STAT=$O(^PRCA(430.3,"AC",114,0))
 | 
|---|
| 8 |  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."
 | 
|---|
| 9 |  W !!,"Ready to purge 'NOW'" S %=2 D YN^DICN I %'=1 G Q
 | 
|---|
| 10 |  D PUR
 | 
|---|
| 11 |  W !!,?5,"Temporay Storage File is empty."
 | 
|---|
| 12 | Q Q
 | 
|---|
| 13 | PUR ;
 | 
|---|
| 14 |  N TGLO
 | 
|---|
| 15 |  L +^PRCAK("PRCAK"):1 I '$T D BUSY^PRCAKS("Kill Temporary Storage File") Q
 | 
|---|
| 16 |  S TGLO=^PRCAK(430.8,0) K ^PRCAK(430.8) S ^PRCAK(430.8,0)=$P(TGLO,"^",1,2)_"^"
 | 
|---|
| 17 |  L -^PRCAK("PRCAK")
 | 
|---|
| 18 |  Q
 | 
|---|