| [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 | 
|---|