source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCGPMK.m@ 1211

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1PRCGPMK ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT - IFCAP PURGEMASTER SUBMANAGER (KILLER) ;12/10/97 9:54 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 S ZTREQ="@"
5 FOR DO Q:$$STOP!END
6 . S END=0
7 . S NODE=$$NEXT
8 . I NODE="" S END=1 QUIT
9 . S DA=$P(NODE,"^"),ROU=$P(NODE,"^",2,3),VARIABLE=$P(NODE,"^",4)
10 . I ROU=""!(ROU="^")!(ROU?.E1"^")!(DA="") QUIT
11 . S X=$P(ROU,"^",2) X ^%ZOSF("TEST") E QUIT
12 . S XROU=ROU I VARIABLE]"" S XROU=ROU_"("_""""_VARIABLE_""""_")"
13 . S IPDA=0 D ADDIP^PRCGPM1(ROU,VARIABLE,.IPDA)
14 . D @XROU S X=$P(ROU,"^",2)
15 . D REMIP^PRCGPM1(IPDA)
16 . K NODE,XROU,ROU,DA,VARIABLE,IPDA
17 . S END=0
18 . QUIT
19 QUIT
20 ;
21ERR ; REPORT ERRORS TO FILE
22 QUIT
23 ;
24STOP() ;CHECK TIME
25 N NOW
26 S NOW=$H
27 I +STOP>(+NOW) QUIT 0
28 I +NOW=(+STOP),$P(NOW,",",2)<$P(STOP,",",2) QUIT 0
29 QUIT 1
30 ;
31NEXT() ;GET NEXT NUMBER FROM 443.1
32 ;EXTRINSIC FUNCTION TO RETURN NEXT AVAILABLE RECORD .
33 NEW DA,I,NODE
34XX S DA=0
35 FOR S DA=$O(^PRC(443.1,DA)) Q:'DA L +^PRC(443.1,DA):4 I Q
36 I DA="" QUIT ""
37 I $D(^PRC(443.1,DA,0))["0" DO G XX
38 . DO REMOVE(DA)
39 . L -^PRC(443.1,DA)
40 . QUIT
41 S NODE=^PRC(443.1,DA,0)
42 D REMOVE(DA)
43 L -^PRC(443.1,DA)
44 QUIT NODE
45 ;
46REMOVE(DA) ;REMOVE ENTRY FROM FILE 443.1
47 ;PARAMETER CALL TO REMOVE RECORD 'DA' FROM FILE
48 NEW NODE,LAST,TOTAL
49 I +DA=0!(DA'=+DA) QUIT
50 I '$D(^PRC(443.1,DA)) QUIT
51 FOR L +^PRC(443.1,0):1 I Q
52 S NODE=^PRC(443.1,0),LAST=$P(NODE,"^",3),TOTAL=$P(NODE,"^",4)
53 K ^PRC(443.1,DA) S TOTAL=TOTAL-1
54 I DA'<LAST F S LAST=LAST-1 Q:($D(^PRC(443.1,LAST))!(LAST=0))
55 S $P(^PRC(443.1,0),"^",3,4)=LAST_"^"_TOTAL
56 I $O(^PRC(443.1,0))="" S $P(^(0),"^",3,4)="^"
57 L -^PRC(443.1,0)
58 QUIT
Note: See TracBrowser for help on using the repository browser.