source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUPMK.m@ 619

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

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1PRCUPMK ;WISC@ALTOONA/CTB/WISC/PLT-IFCAP GENERAL BATCH PROCESS UTILITY ; 06 Apr 93 12:07 PM
2V ;;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 ;
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
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 ;
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 L -^PRC(443.1,0)
57 QUIT
Note: See TracBrowser for help on using the repository browser.