| 1 | PRCG239P ;WISC/BGJ - IFCAP 442 FILE CLEANUP (PURGE); 11/5/99 12:22pm ;9/20/00  12:56 | 
|---|
| 2 | V ;;5.1;IFCAP;**95**;Oct 20, 2000 | 
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified. | 
|---|
| 4 | ;This routine is installed by patch PRC*5.1*95. | 
|---|
| 5 | ;The purpose of this routine is to clean up FMS reconcilliation data | 
|---|
| 6 | ;in file 417 that were not purged by running the Archive/Purge | 
|---|
| 7 | ;functionality.  Routine PRCG239Q is a routine installed by patch | 
|---|
| 8 | ;95 that queues entries into PurgeMaster for purging.  Those entries | 
|---|
| 9 | ;are then purged by this routine as PurgeMaster cycles through file | 
|---|
| 10 | ;443.1 (PurgeMaster Worklist). | 
|---|
| 11 | ; | 
|---|
| 12 | 417(X) ; | 
|---|
| 13 | N DA,KDA,BEGDA,ENDA,PODATE,DTPOASN,SITE,DATE,ZERONODE,MOP | 
|---|
| 14 | D UNLOAD | 
|---|
| 15 | F  S DA=$O(^PRCS(417,DA)) Q:'DA!(DA>ENDA)  D | 
|---|
| 16 | . S ZERONODE=$G(^PRCS(417,DA,0)) Q:ZERONODE="" | 
|---|
| 17 | . S PODATE=$P($G(^PRCS(417,DA,0)),"^",22) | 
|---|
| 18 | . I PODATE>DATE Q | 
|---|
| 19 | . S KDA=DA D KILL417(KDA) | 
|---|
| 20 | Q | 
|---|
| 21 | UNLOAD ; | 
|---|
| 22 | S BEGDA=$P(X,"-",1),ENDA=+$P(X,"-",2),SITE=$P(X,";",2) | 
|---|
| 23 | S DATE=$P(X,";",3) | 
|---|
| 24 | S DA=BEGDA-.1 | 
|---|
| 25 | Q | 
|---|
| 26 | KILL417(DA) ; | 
|---|
| 27 | Q:'$D(^PRCS(417,DA,0)) | 
|---|
| 28 | S DIK="^PRCS(417," D ^DIK | 
|---|
| 29 | K DIK | 
|---|
| 30 | Q | 
|---|