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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCUPM1 2306 printed Sep 23, 2025@19:55:52 Page 2
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
+1 ;This routine contains misc functions/tools to be used by the
+2 ;purge package
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
+2 ;ARGUEMENT LIST = RECORD NUMBER (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
+3 ;X= ENTRY POINT^ROUTINE NAME
+4 ;Y= VARIABLE STRING
+5 NEW NODE,LAST,TOTAL,DONE
+6 IF X=""
SET Z=0
QUIT
+7 LOCK +^PRC(443.1,0):10
IF '$TEST
SET Z=0
QUIT
+8 SET NODE=^PRC(443.1,0)
SET LAST=$PIECE(NODE,"^",3)
SET TOTAL=$PIECE(NODE,"^",4)
+9 FOR
Begin DoDot:1
+10 SET LAST=LAST+1
+11 if X'["^"
SET X="^"_X
+12 IF '$DATA(^PRC(443.1,LAST))
SET ^PRC(443.1,LAST,0)=LAST_"^"_X_"^"_Y
SET $PIECE(^PRC(443.1,0),"^",3,4)=(LAST_"^"_(TOTAL+1))
SET DONE=1
+13 QUIT
End DoDot:1
if $DATA(DONE)
QUIT
+14 LOCK -^PRC(443.1,0)
+15 SET Z=1
QUIT
REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
+1 ;PARAMATER CALL TO REMOVE RECORD 'DA' FROM FILE
+2 NEW NODE,LAST,TOTAL
+3 IF +DA=0!(DA'=+DA)
QUIT
+4 IF '$DATA(^PRC(443.1,DA))
QUIT
+5 FOR
LOCK +^PRC(443.1,0):1
IF $TEST
QUIT
+6 SET NODE=^PRC(443.1,0)
SET LAST=$PIECE(NODE,"^",3)
SET TOTAL=$PIECE(NODE,"^",4)
+7 KILL ^PRC(443.1,DA)
SET TOTAL=TOTAL-1
+8 IF DA'<LAST
FOR
SET LAST=LAST-1
if ($DATA(^PRC(443.1,LAST))!(LAST=0))
QUIT
+9 SET $PIECE(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
+10 LOCK -^PRC(443.1,0)
+11 QUIT
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
+2 ;ARGUEMENT LIST = RECORD NUM (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
+3 ;X= ENTRY POINT^ROUTINE NAME
+4 ;Y= VARIABLE STRING
+5 NEW NODE,LAST,TOTAL,DONE
+6 IF (X="")!(Y="")
SET Z=0
QUIT
+7 LOCK +^PRC(443.3,0)
+8 SET NODE=^PRC(443.3,0)
SET LAST=$PIECE(NODE,"^",3)
SET TOTAL=$PIECE(NODE,"^",4)
+9 FOR
Begin DoDot:1
+10 SET LAST=LAST+1
+11 if X'["^"
SET X="^"_X
+12 IF '$DATA(^PRC(443.3,LAST))
SET ^PRC(443.3,LAST,0)=LAST_"^"_X_"^"_Y
SET ^(1)=$HOROLOG
SET $PIECE(^PRC(443.3,0),"^",3,4)=(LAST_"^"_(TOTAL+1))
SET DONE=LAST
+13 QUIT
End DoDot:1
if $DATA(DONE)
QUIT
+14 LOCK -^PRC(443.3,0)
+15 SET Z=DONE
QUIT
REMIP(DA) ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE 443.3
+1 NEW NODE,LAST,TOTAL
+2 IF +DA=0!(DA'=+DA)
QUIT
+3 IF '$DATA(^PRC(443.3,DA))
QUIT
+4 FOR
LOCK +^PRC(443.3,0):1
IF $TEST
QUIT
+5 SET NODE=^PRC(443.3,0)
SET LAST=$PIECE(NODE,"^",3)
SET TOTAL=$PIECE(NODE,"^",4)
+6 KILL ^PRC(443.3,DA)
SET TOTAL=TOTAL-1
+7 IF DA'<LAST
FOR
SET LAST=LAST-1
if ($DATA(^PRC(443.3,LAST))!(LAST=0))
QUIT
+8 SET $PIECE(^PRC(443.3,0),"^",3,4)=LAST_"^"_TOTAL
+9 LOCK -^PRC(443.3,0)
+10 QUIT
