| [613] | 1 | PRCUPM1 ;WISC@ALTOONA/CTB/WISC/PLT-IFCAP GENERAL BATCH PROCESS PRCUPM CONT. ; 06 Apr 93  12:05 PM
 | 
|---|
 | 2 | V ;;5.0;IFCAP;;4/21/95
 | 
|---|
 | 3 |  ;This routine contains misc functions/tools to be used by the
 | 
|---|
 | 4 |  ;purge package
 | 
|---|
 | 5 | ADD(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO PURGE MASTER FILE
 | 
|---|
 | 6 |  ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=1 (ONE) IF SUCCESSFUL
 | 
|---|
 | 7 |  ;ARGUEMENT LIST = RECORD NUMBER (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
 | 
|---|
 | 8 |  ;X= ENTRY POINT^ROUTINE NAME
 | 
|---|
 | 9 |  ;Y= VARIABLE STRING
 | 
|---|
 | 10 |  NEW NODE,LAST,TOTAL,DONE
 | 
|---|
 | 11 |  I X="" S Z=0 QUIT
 | 
|---|
 | 12 |  L +^PRC(443.1,0):10 I '$T S Z=0 QUIT
 | 
|---|
 | 13 |  S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 | 
|---|
 | 14 |  F  D  Q:$D(DONE)
 | 
|---|
 | 15 |  . S LAST=LAST+1
 | 
|---|
 | 16 |  . S:X'["^" X="^"_X
 | 
|---|
 | 17 |  . 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
 | 
|---|
 | 18 |  . QUIT
 | 
|---|
 | 19 |  L -^PRC(443.1,0)
 | 
|---|
 | 20 |  S Z=1 QUIT
 | 
|---|
 | 21 | REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
 | 
|---|
 | 22 |  ;PARAMATER CALL TO REMOVE RECORD 'DA' FROM FILE
 | 
|---|
 | 23 |  NEW NODE,LAST,TOTAL
 | 
|---|
 | 24 |  I +DA=0!(DA'=+DA) QUIT
 | 
|---|
 | 25 |  I '$D(^PRC(443.1,DA)) QUIT
 | 
|---|
 | 26 |  FOR  L +^PRC(443.1,0):1 I  Q
 | 
|---|
 | 27 |  S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 | 
|---|
 | 28 |  K ^PRC(443.1,DA) S TOTAL=TOTAL-1
 | 
|---|
 | 29 |  I DA'<LAST F  S LAST=LAST-1 Q:($D(^PRC(443.1,LAST))!(LAST=0))
 | 
|---|
 | 30 |  S $P(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
 | 
|---|
 | 31 |  L -^PRC(443.1,0)
 | 
|---|
 | 32 |  QUIT
 | 
|---|
 | 33 | ADDIP(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO INPROCESS FILE
 | 
|---|
 | 34 |  ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=DA NUMBER IF SUCCESSFUL
 | 
|---|
 | 35 |  ;ARGUEMENT LIST = RECORD NUM (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
 | 
|---|
 | 36 |  ;X= ENTRY POINT^ROUTINE NAME
 | 
|---|
 | 37 |  ;Y= VARIABLE STRING
 | 
|---|
 | 38 |  NEW NODE,LAST,TOTAL,DONE
 | 
|---|
 | 39 |  I (X="")!(Y="") S Z=0 QUIT
 | 
|---|
 | 40 |  L +^PRC(443.3,0)
 | 
|---|
 | 41 |  S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 | 
|---|
 | 42 |  F  D  Q:$D(DONE)
 | 
|---|
 | 43 |  . S LAST=LAST+1
 | 
|---|
 | 44 |  . S:X'["^" X="^"_X
 | 
|---|
 | 45 |  . 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
 | 
|---|
 | 46 |  . QUIT
 | 
|---|
 | 47 |  L -^PRC(443.3,0)
 | 
|---|
 | 48 |  S Z=DONE QUIT
 | 
|---|
 | 49 | REMIP(DA) ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE 443.3
 | 
|---|
 | 50 |  NEW NODE,LAST,TOTAL
 | 
|---|
 | 51 |  I +DA=0!(DA'=+DA) QUIT
 | 
|---|
 | 52 |  I '$D(^PRC(443.3,DA)) QUIT
 | 
|---|
 | 53 |  FOR  L +^PRC(443.3,0):1 I  Q
 | 
|---|
 | 54 |  S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
 | 
|---|
 | 55 |  K ^PRC(443.3,DA) S TOTAL=TOTAL-1
 | 
|---|
 | 56 |  I DA'<LAST F  S LAST=LAST-1 Q:($D(^PRC(443.3,LAST))!(LAST=0))
 | 
|---|
 | 57 |  S $P(^PRC(443.3,0),"^",3,4)=LAST_"^"_TOTAL
 | 
|---|
 | 58 |  L -^PRC(443.3,0)
 | 
|---|
 | 59 |  QUIT
 | 
|---|