source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUPM1.m@ 1351

Last change on this file since 1351 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1PRCUPM1 ;WISC@ALTOONA/CTB/WISC/PLT-IFCAP GENERAL BATCH PROCESS PRCUPM CONT. ; 06 Apr 93 12:05 PM
2V ;;5.0;IFCAP;;4/21/95
3 ;This routine contains misc functions/tools to be used by the
4 ;purge package
5ADD(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
21REMOVE(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
33ADDIP(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
49REMIP(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
Note: See TracBrowser for help on using the repository browser.