source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCGPM1.m@ 1078

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1PRCGPM1 ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT/BGJ - IFCAP PURGEMASTER PROCESS PRCGPM CONT. ;12/10/97 9:53 AM
2V ;;5.1;IFCAP;**95**;Oct 20, 2000
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;This routine contains misc functions/tools to be used by the
5 ;purge package
6ADD(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO PURGE MASTER FILE
7 ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=1 (ONE) IF SUCCESSFUL
8 ;ARGUEMENT LIST = RECORD NUMBER (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
9 ;X= ENTRY POINT^ROUTINE NAME
10 ;Y= VARIABLE STRING
11 NEW NODE,LAST,TOTAL,DONE
12 I X="" S Z=0 QUIT
13 L +^PRC(443.1,0):10 I '$T S Z=0 QUIT
14 S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
15 F D Q:$D(DONE)
16 . S LAST=LAST+1
17 . S:X'["^" X="^"_X
18 . 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
19 . QUIT
20 L -^PRC(443.1,0)
21 S Z=1 QUIT
22REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
23 ;PARAMATER CALL TO REMOVE RECORD 'DA' FROM FILE
24 NEW NODE,LAST,TOTAL
25 I +DA=0!(DA'=+DA) QUIT
26 I '$D(^PRC(443.1,DA)) QUIT
27 FOR L +^PRC(443.1,0):1 I Q
28 S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
29 K ^PRC(443.1,DA) S TOTAL=TOTAL-1
30 I DA'<LAST F S LAST=LAST-1 Q:($D(^PRC(443.1,LAST))!(LAST=0))
31 S $P(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
32 L -^PRC(443.1,0)
33 QUIT
34ADDIP(X,Y,Z) ;PARAMETER CALL TO ADD NEW ENTRY TO INPROCESS FILE
35 ;RETURNS Z=0 (ZERO) IF UNSUCCESSFUL, Z=DA NUMBER IF SUCCESSFUL
36 ;ARGUEMENT LIST = RECORD NUM (DA)^ENTRY POINT^ROUTINE NAME^VARIABLE STRING
37 ;X= ENTRY POINT^ROUTINE NAME
38 ;Y= VARIABLE STRING
39 NEW NODE,LAST,TOTAL,DONE
40 I (X="") S Z=0 QUIT
41 F L +^PRC(443.3,0):1 I Q
42 S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
43 F D Q:$D(DONE)
44 . S LAST=LAST+1
45 . S:X'["^" X="^"_X
46 . 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
47 . QUIT
48 L -^PRC(443.3,0)
49 S Z=DONE QUIT
50REMIP(DA) ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE 443.3
51 NEW NODE,LAST,TOTAL
52 I +DA=0!(DA'=+DA) QUIT
53 I '$D(^PRC(443.3,DA)) QUIT
54 FOR L +^PRC(443.3,0):1 I Q
55 S NODE=^PRC(443.3,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
56 K ^PRC(443.3,DA) S TOTAL=TOTAL-1
57 I DA'<LAST F S LAST=LAST-1 Q:($D(^PRC(443.3,LAST))!(LAST=0))
58 S $P(^PRC(443.3,0),"^",3,4)=LAST_"^"_TOTAL
59 I $O(^PRC(443.3,0))="" S $P(^PRC(443.0),"^",3,4)="^"
60 L -^PRC(443.3,0)
61 QUIT
62CLN445 ;add line to delete
63 S MYHLD=0,MYCOUNT=0,THISCNT=0
64 F S MYHLD=$O(^PRC(443.1,MYHLD)) Q:'MYHLD S MYCOUNT=MYHLD
65 S LAST=MYCOUNT+1
66 S X="FIND445^PRCG238P"
67 S THISCNT=$P(^PRC(443.1,0),U,4)
68 S Y=""
69 S:X'["^" X="^"_X
70 I '$D(^PRC(443.1,LAST)) S ^PRC(443.1,LAST,0)=LAST_"^"_X_"^"_Y,$P(^PRC(443.1,0),"^",3,4)=(LAST_"^"_(THISCNT+1))
71 K MYHLD,MYCOUNT,THISCNT
72 Q
Note: See TracBrowser for help on using the repository browser.