PRCG239P.m

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 ---PRCG239P   1094     printed  Apr 09, 2024@21:09:38                                                                                                                                                                                                    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