| 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
|
---|