| [613] | 1 | PRCUPMK ;WISC@ALTOONA/CTB/WISC/PLT-IFCAP GENERAL BATCH PROCESS UTILITY ; 06 Apr 93  12:07 PM
 | 
|---|
 | 2 | V ;;5.0;IFCAP;;4/21/95
 | 
|---|
 | 3 |  ;S $ZT="ERR^PRCUPMK"
 | 
|---|
 | 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^PRCUPM1(ROU,VARIABLE,.IPDA)
 | 
|---|
 | 14 |  . D @XROU
 | 
|---|
 | 15 |  . D REMIP^PRCUPM1(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 |  S DA=0
 | 
|---|
 | 35 |  FOR  S DA=$O(^PRC(443.1,DA)) Q:'DA  L +^PRC(443.1,DA):2 I  Q
 | 
|---|
 | 36 |  I DA="" QUIT ""
 | 
|---|
 | 37 |  I $D(^PRC(443.1,DA,0))["0" DO  QUIT ""
 | 
|---|
 | 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 |   L -^PRC(443.1,0)
 | 
|---|
 | 57 |   QUIT
 | 
|---|