| 1 | PRCGPMK ;WIRMFO@ALTOONA/CTB/WIRMFO/PLT - IFCAP PURGEMASTER SUBMANAGER (KILLER) ;12/10/97 9:54 AM
|
|---|
| 2 | V ;;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 | ;
|
|---|
| 21 | ERR ; REPORT ERRORS TO FILE
|
|---|
| 22 | QUIT
|
|---|
| 23 | ;
|
|---|
| 24 | STOP() ;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 | ;
|
|---|
| 31 | NEXT() ;GET NEXT NUMBER FROM 443.1
|
|---|
| 32 | ;EXTRINSIC FUNCTION TO RETURN NEXT AVAILABLE RECORD .
|
|---|
| 33 | NEW DA,I,NODE
|
|---|
| 34 | XX 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 | ;
|
|---|
| 46 | REMOVE(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
|
|---|
