| [613] | 1 | PRCGPM1 ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT/BGJ - IFCAP PURGEMASTER PROCESS PRCGPM CONT. ;12/10/97 9:53 AM
|
|---|
| 2 | V ;;5.1;IFCAP;**95**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;This routine contains misc functions/tools to be used by the
|
|---|
| 5 | ;purge package
|
|---|
| 6 | ADD(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO PURGE MASTER FILE
|
|---|
| 7 | ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=1 (ONE) IF SUCCESSFUL
|
|---|
| 8 | ;ARGUEMENT LIST = RECORD NUMBER (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
|
|---|
| 9 | ;X= ENTRY POINT^ROUTINE NAME
|
|---|
| 10 | ;Y= VARIABLE STRING
|
|---|
| 11 | NEW NODE,LAST,TOTAL,DONE
|
|---|
| 12 | I X="" S Z=0 QUIT
|
|---|
| 13 | L +^PRC(443.1,0):10 I '$T S Z=0 QUIT
|
|---|
| 14 | S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
|
|---|
| 15 | F D Q:$D(DONE)
|
|---|
| 16 | . S LAST=LAST+1
|
|---|
| 17 | . S:X'["^" X="^"_X
|
|---|
| 18 | . 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
|
|---|
| 19 | . QUIT
|
|---|
| 20 | L -^PRC(443.1,0)
|
|---|
| 21 | S Z=1 QUIT
|
|---|
| 22 | REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
|
|---|
| 23 | ;PARAMATER CALL TO REMOVE RECORD 'DA' FROM FILE
|
|---|
| 24 | NEW NODE,LAST,TOTAL
|
|---|
| 25 | I +DA=0!(DA'=+DA) QUIT
|
|---|
| 26 | I '$D(^PRC(443.1,DA)) QUIT
|
|---|
| 27 | FOR L +^PRC(443.1,0):1 I Q
|
|---|
| 28 | S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
|
|---|
| 29 | K ^PRC(443.1,DA) S TOTAL=TOTAL-1
|
|---|
| 30 | I DA'<LAST F S LAST=LAST-1 Q:($D(^PRC(443.1,LAST))!(LAST=0))
|
|---|
| 31 | S $P(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
|
|---|
| 32 | L -^PRC(443.1,0)
|
|---|
| 33 | QUIT
|
|---|
| 34 | ADDIP(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO INPROCESS FILE
|
|---|
| 35 | ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=DA NUMBER IF SUCCESSFUL
|
|---|
| 36 | ;ARGUEMENT LIST = RECORD NUM (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
|
|---|
| 37 | ;X= ENTRY POINT^ROUTINE NAME
|
|---|
| 38 | ;Y= VARIABLE STRING
|
|---|
| 39 | NEW NODE,LAST,TOTAL,DONE
|
|---|
| 40 | I (X="") S Z=0 QUIT
|
|---|
| 41 | F L +^PRC(443.3,0):1 I Q
|
|---|
| 42 | S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
|
|---|
| 43 | F D Q:$D(DONE)
|
|---|
| 44 | . S LAST=LAST+1
|
|---|
| 45 | . S:X'["^" X="^"_X
|
|---|
| 46 | . 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
|
|---|
| 47 | . QUIT
|
|---|
| 48 | L -^PRC(443.3,0)
|
|---|
| 49 | S Z=DONE QUIT
|
|---|
| 50 | REMIP(DA) ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE 443.3
|
|---|
| 51 | NEW NODE,LAST,TOTAL
|
|---|
| 52 | I +DA=0!(DA'=+DA) QUIT
|
|---|
| 53 | I '$D(^PRC(443.3,DA)) QUIT
|
|---|
| 54 | FOR L +^PRC(443.3,0):1 I Q
|
|---|
| 55 | S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
|
|---|
| 56 | K ^PRC(443.3,DA) S TOTAL=TOTAL-1
|
|---|
| 57 | I DA'<LAST F S LAST=LAST-1 Q:($D(^PRC(443.3,LAST))!(LAST=0))
|
|---|
| 58 | S $P(^PRC(443.3,0),"^",3,4)=LAST_"^"_TOTAL
|
|---|
| 59 | I $O(^PRC(443.3,0))="" S $P(^PRC(443.0),"^",3,4)="^"
|
|---|
| 60 | L -^PRC(443.3,0)
|
|---|
| 61 | QUIT
|
|---|
| 62 | CLN445 ;add line to delete
|
|---|
| 63 | S MYHLD=0,MYCOUNT=0,THISCNT=0
|
|---|
| 64 | F S MYHLD=$O(^PRC(443.1,MYHLD)) Q:'MYHLD S MYCOUNT=MYHLD
|
|---|
| 65 | S LAST=MYCOUNT+1
|
|---|
| 66 | S X="FIND445^PRCG238P"
|
|---|
| 67 | S THISCNT=$P(^PRC(443.1,0),U,4)
|
|---|
| 68 | S Y=""
|
|---|
| 69 | S:X'["^" X="^"_X
|
|---|
| 70 | 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))
|
|---|
| 71 | K MYHLD,MYCOUNT,THISCNT
|
|---|
| 72 | Q
|
|---|
