60 lines
2.2 KiB
Mathematica
60 lines
2.2 KiB
Mathematica
PRCUPM1 ;WISC@ALTOONA/CTB/WISC/PLT-IFCAP GENERAL BATCH PROCESS PRCUPM CONT. ; 06 Apr 93 12:05 PM
|
|
V ;;5.0;IFCAP;;4/21/95
|
|
;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="")!(Y="") S Z=0 QUIT
|
|
L +^PRC(443.3,0)
|
|
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
|
|
L -^PRC(443.3,0)
|
|
QUIT
|