source: WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEQSUB.m@ 724

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1RGEQSUB ;BHM/RGY,DKM-Dequeue processor ;14-Oct-1998
2 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
3SUBPROC ;
4 NEW ENT,CURTIME,HTIME,HORLOG,PARAM,STAT,PROG,ERROR,RGLOG
5 L +^RGEQ(TYPE):1 E Q
6 S ENT=$G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),0))
7 S X=+$P(ENT,"^",3) S:X<1!(X>10) X=10 X ^%ZOSF("PRIORITY")
8 I $$NEWERR^%ZTER N $ET S $ET=""
9 S HTIME=+$P($G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),0)),"^",4)
10 S:HTIME<30 HTIME=30
11 S CURTIME=0
12 F Q:$$ESTOP^RGEQDMN1(TYPE)!(CURTIME'<HTIME) D
13 .M ^RGEQ(TYPE)=^RGEQ("ADQ",TYPE)
14 .K ^RGEQ("ADQ")
15 .I $O(^RGEQ(TYPE,""))]"" D PROCESS S CURTIME=0 Q
16 .S CURTIME=CURTIME+5
17 .H 5
18 .Q
19 L -^RGEQ(TYPE)
20 K TYPE Q
21PROCESS ;
22 S PARAM="",STAT=$$ENT^RGEQSTAT(TYPE),HORLOG=+$H
23 S PROG=$P($G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),1)),"^",1,2)
24 I PROG="" S PROG="EVENT TYPE DOES NOT EXIST"
25 E D
26 .S X=$P(PROG,"^",2)
27 .I X="" S PROG="INVALID PROGRAM NAME"
28 .E D
29 ..X ^%ZOSF("TEST")
30 ..I '$T S PROG="PROGRAM DOES NOT EXIST"
31 ..Q
32 .Q
33 F S PARAM=$O(^RGEQ(TYPE,PARAM)) Q:PARAM="" D
34 .I +$H'=HORLOG S STAT=$$ENT^RGEQSTAT(TYPE),HORLOG=+$H
35 .I PROG'["^" D Q
36 ..D SET^RGEQEXC(TYPE,PROG,PARAM)
37 ..K ^RGEQ(TYPE,PARAM)
38 ..S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
39 ..Q
40 .S X="ERROR^RGEQSUB",@^%ZOSF("TRAP"),ERROR=""
41 .D START^RGHLLOG(,TYPE,PARAM)
42 .S ^RGEQ("ADQ",TYPE,PARAM)=""
43 .K ^RGEQ(TYPE,PARAM)
44 .D @(PROG_"("""_TYPE_""","""_PARAM_""",.ERROR,"""_$P(ENT,"^",2)_""")")
45 .I ERROR="" S $P(^RGSTAT(995.2,STAT,1),"^")=$P($G(^RGSTAT(995.2,STAT,1)),"^")+1
46 .I ERROR]"" D
47 ..S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
48 ..D EXC^RGHLLOG(ERROR),SET^RGEQEXC(TYPE,ERROR,PARAM)
49 ..Q
50 .K ^RGEQ("ADQ",TYPE,PARAM)
51 .D STOP^RGHLLOG(0)
52 .Q
53 Q
54ERROR ;Come here on application error
55 N ERROR
56 S ERROR=$$EC^%ZOSV
57 S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
58 D EXC^RGHLLOG(6,ERROR),SET^RGEQEXC(TYPE,ERROR,PARAM)
59 K ^RGEQ("ADQ",TYPE,PARAM),^RGEQ(TYPE,PARAM)
60 D STOP^RGHLLOG(1),^%ZTER
61 Q
Note: See TracBrowser for help on using the repository browser.