PRCG239P ;WISC/BGJ - IFCAP 442 FILE CLEANUP (PURGE); 11/5/99 12:22pm ;9/20/00 12:56
V ;;5.1;IFCAP;**95,138**;Oct 20, 2000;Build 18
;Per VHA Directive 2004-038, this routine should not be modified.
;This routine is installed by patch PRC*5.1*95.
;The purpose of this routine is to clean up FMS reconciliation data
;in file 417 that were not purged by running the Archive/Purge
;functionality. Routine PRCG239Q is a routine installed by patch
;95 that queues entries into PurgeMaster for purging. Those entries
;are then purged by this routine as PurgeMaster cycles through file
;443.1 (PurgeMaster Worklist).
;
417(X) ;
N DA,KDA,BEGDA,ENDA,PODATE,DTPOASN,SITE,DATE,ZERONODE,MOP
D UNLOAD
F S DA=$O(^PRCS(417,DA)) Q:'DA!(DA>ENDA) D
. S ZERONODE=$G(^PRCS(417,DA,0)) Q:ZERONODE=""
. S PODATE=$P($G(^PRCS(417,DA,0)),"^",22)
. I PODATE>DATE Q
. S KDA=DA D KILL417(KDA)
Q
UNLOAD ;
S BEGDA=$P(X,"-",1),ENDA=+$P(X,"-",2),SITE=$P(X,";",2)
S DATE=$P(X,";",3)
S DA=BEGDA-.1
Q
KILL417(DA) ;
Q:'$D(^PRCS(417,DA,0))
S DIK="^PRCS(417," D ^DIK
K DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCG239P 1094 printed Dec 13, 2024@02:04:40 Page 2
PRCG239P ;WISC/BGJ - IFCAP 442 FILE CLEANUP (PURGE); 11/5/99 12:22pm ;9/20/00 12:56
V ;;5.1;IFCAP;**95,138**;Oct 20, 2000;Build 18
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 ;This routine is installed by patch PRC*5.1*95.
+3 ;The purpose of this routine is to clean up FMS reconciliation data
+4 ;in file 417 that were not purged by running the Archive/Purge
+5 ;functionality. Routine PRCG239Q is a routine installed by patch
+6 ;95 that queues entries into PurgeMaster for purging. Those entries
+7 ;are then purged by this routine as PurgeMaster cycles through file
+8 ;443.1 (PurgeMaster Worklist).
+9 ;
417(X) ;
+1 NEW DA,KDA,BEGDA,ENDA,PODATE,DTPOASN,SITE,DATE,ZERONODE,MOP
+2 DO UNLOAD
+3 FOR
SET DA=$ORDER(^PRCS(417,DA))
if 'DA!(DA>ENDA)
QUIT
Begin DoDot:1
+4 SET ZERONODE=$GET(^PRCS(417,DA,0))
if ZERONODE=""
QUIT
+5 SET PODATE=$PIECE($GET(^PRCS(417,DA,0)),"^",22)
+6 IF PODATE>DATE
QUIT
+7 SET KDA=DA
DO KILL417(KDA)
End DoDot:1
+8 QUIT
UNLOAD ;
+1 SET BEGDA=$PIECE(X,"-",1)
SET ENDA=+$PIECE(X,"-",2)
SET SITE=$PIECE(X,";",2)
+2 SET DATE=$PIECE(X,";",3)
+3 SET DA=BEGDA-.1
+4 QUIT
KILL417(DA) ;
+1 if '$DATA(^PRCS(417,DA,0))
QUIT
+2 SET DIK="^PRCS(417,"
DO ^DIK
+3 KILL DIK
+4 QUIT
