Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCGPM1

PRCGPM1.m

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