PRCGPM1 ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT/BGJ - IFCAP PURGEMASTER PROCESS PRCGPM CONT. ;12/10/97  9:53 AM
V ;;5.1;IFCAP;**95**;Oct 20, 2000
 ;Per VHA Directive 2004-038, this routine should not be modified.
 ;This routine contains misc functions/tools to be used by the
 ;purge package
ADD(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO PURGE MASTER FILE
 ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=1 (ONE) IF SUCCESSFUL
 ;ARGUEMENT LIST = RECORD NUMBER (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
 ;X= ENTRY POINT^ROUTINE NAME
 ;Y= VARIABLE STRING
 NEW NODE,LAST,TOTAL,DONE
 I X="" S Z=0 QUIT
 L +^PRC(443.1,0):10 I '$T S Z=0 QUIT
 S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 F  D  Q:$D(DONE)
 . S LAST=LAST+1
 . S:X'["^" X="^"_X
 . I '$D(^PRC(443.1,LAST)) S ^PRC(443.1,LAST,0)=LAST_"^"_X_"^"_Y,$P(^PRC(443.1,0),"^",3,4)=(LAST_"^"_(TOTAL+1)),DONE=1
 . QUIT
 L -^PRC(443.1,0)
 S Z=1 QUIT
REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
 ;PARAMATER CALL TO REMOVE RECORD 'DA' FROM FILE
 NEW NODE,LAST,TOTAL
 I +DA=0!(DA'=+DA) QUIT
 I '$D(^PRC(443.1,DA)) QUIT
 FOR  L +^PRC(443.1,0):1 I  Q
 S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 K ^PRC(443.1,DA) S TOTAL=TOTAL-1
 I DA'<LAST F  S LAST=LAST-1 Q:($D(^PRC(443.1,LAST))!(LAST=0))
 S $P(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
 L -^PRC(443.1,0)
 QUIT
ADDIP(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO INPROCESS FILE
 ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=DA NUMBER IF SUCCESSFUL
 ;ARGUEMENT LIST = RECORD NUM (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
 ;X= ENTRY POINT^ROUTINE NAME
 ;Y= VARIABLE STRING
 NEW NODE,LAST,TOTAL,DONE
 I (X="") S Z=0 QUIT
 F  L +^PRC(443.3,0):1 I  Q
 S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 F  D  Q:$D(DONE)
 . S LAST=LAST+1
 . S:X'["^" X="^"_X
 . I '$D(^PRC(443.3,LAST)) S ^PRC(443.3,LAST,0)=LAST_"^"_X_"^"_Y,^(1)=$H,$P(^PRC(443.3,0),"^",3,4)=(LAST_"^"_(TOTAL+1)),DONE=LAST
 . QUIT
 L -^PRC(443.3,0)
 S Z=DONE QUIT
REMIP(DA) ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE 443.3
 NEW NODE,LAST,TOTAL
 I +DA=0!(DA'=+DA) QUIT
 I '$D(^PRC(443.3,DA)) QUIT
 FOR  L +^PRC(443.3,0):1 I  Q
 S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 K ^PRC(443.3,DA) S TOTAL=TOTAL-1
 I DA'<LAST F  S LAST=LAST-1 Q:($D(^PRC(443.3,LAST))!(LAST=0))
 S $P(^PRC(443.3,0),"^",3,4)=LAST_"^"_TOTAL
 I $O(^PRC(443.3,0))="" S $P(^PRC(443.0),"^",3,4)="^"
 L -^PRC(443.3,0)
 QUIT
CLN445 ;add line to delete
 S MYHLD=0,MYCOUNT=0,THISCNT=0
 F  S MYHLD=$O(^PRC(443.1,MYHLD)) Q:'MYHLD  S MYCOUNT=MYHLD
 S LAST=MYCOUNT+1
 S X="FIND445^PRCG238P"
 S THISCNT=$P(^PRC(443.1,0),U,4)
 S Y=""
 S:X'["^" X="^"_X
 I '$D(^PRC(443.1,LAST)) S ^PRC(443.1,LAST,0)=LAST_"^"_X_"^"_Y,$P(^PRC(443.1,0),"^",3,4)=(LAST_"^"_(THISCNT+1))
 K MYHLD,MYCOUNT,THISCNT
 Q