Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGEQSUB

RGEQSUB.m

Go to the documentation of this file.
RGEQSUB ;BHM/RGY,DKM-Dequeue processor ;14-Oct-1998
 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
SUBPROC ;
 NEW ENT,CURTIME,HTIME,HORLOG,PARAM,STAT,PROG,ERROR,RGLOG
 L +^RGEQ(TYPE):1 E  Q
 S ENT=$G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),0))
 S X=+$P(ENT,"^",3) S:X<1!(X>10) X=10 X ^%ZOSF("PRIORITY")
 I $$NEWERR^%ZTER N $ET S $ET=""
 S HTIME=+$P($G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),0)),"^",4)
 S:HTIME<30 HTIME=30
 S CURTIME=0
 F  Q:$$ESTOP^RGEQDMN1(TYPE)!(CURTIME'<HTIME)  D
 .M ^RGEQ(TYPE)=^RGEQ("ADQ",TYPE)
 .K ^RGEQ("ADQ")
 .I $O(^RGEQ(TYPE,""))]"" D PROCESS S CURTIME=0 Q
 .S CURTIME=CURTIME+5
 .H 5
 .Q
 L -^RGEQ(TYPE)
 K TYPE Q
PROCESS ;
 S PARAM="",STAT=$$ENT^RGEQSTAT(TYPE),HORLOG=+$H
 S PROG=$P($G(^RGEQASN(+$O(^RGEQASN("B",TYPE,0)),1)),"^",1,2)
 I PROG="" S PROG="EVENT TYPE DOES NOT EXIST"
 E  D
 .S X=$P(PROG,"^",2)
 .I X="" S PROG="INVALID PROGRAM NAME"
 .E  D
 ..X ^%ZOSF("TEST")
 ..I '$T S PROG="PROGRAM DOES NOT EXIST"
 ..Q
 .Q
 F  S PARAM=$O(^RGEQ(TYPE,PARAM)) Q:PARAM=""  D
 .I +$H'=HORLOG S STAT=$$ENT^RGEQSTAT(TYPE),HORLOG=+$H
 .I PROG'["^" D  Q
 ..D SET^RGEQEXC(TYPE,PROG,PARAM)
 ..K ^RGEQ(TYPE,PARAM)
 ..S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
 ..Q
 .S X="ERROR^RGEQSUB",@^%ZOSF("TRAP"),ERROR=""
 .D START^RGHLLOG(,TYPE,PARAM)
 .S ^RGEQ("ADQ",TYPE,PARAM)=""
 .K ^RGEQ(TYPE,PARAM)
 .D @(PROG_"("""_TYPE_""","""_PARAM_""",.ERROR,"""_$P(ENT,"^",2)_""")")
 .I ERROR="" S $P(^RGSTAT(995.2,STAT,1),"^")=$P($G(^RGSTAT(995.2,STAT,1)),"^")+1
 .I ERROR]"" D
 ..S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
 ..D EXC^RGHLLOG(ERROR),SET^RGEQEXC(TYPE,ERROR,PARAM)
 ..Q
 .K ^RGEQ("ADQ",TYPE,PARAM)
 .D STOP^RGHLLOG(0)
 .Q
 Q
ERROR ;Come here on application error
 N ERROR
 S ERROR=$$EC^%ZOSV
 S $P(^RGSTAT(995.2,STAT,1),"^",2)=$P($G(^RGSTAT(995.2,STAT,1)),"^",2)+1
 D EXC^RGHLLOG(6,ERROR),SET^RGEQEXC(TYPE,ERROR,PARAM)
 K ^RGEQ("ADQ",TYPE,PARAM),^RGEQ(TYPE,PARAM)
 D STOP^RGHLLOG(1),^%ZTER
 Q