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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEQSUB 2025 printed Sep 23, 2025@19:17:37 Page 2
RGEQSUB ;BHM/RGY,DKM-Dequeue processor ;14-Oct-1998
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
SUBPROC ;
+1 NEW ENT,CURTIME,HTIME,HORLOG,PARAM,STAT,PROG,ERROR,RGLOG
+2 LOCK +^RGEQ(TYPE):1
IF '$TEST
QUIT
+3 SET ENT=$GET(^RGEQASN(+$ORDER(^RGEQASN("B",TYPE,0)),0))
+4 SET X=+$PIECE(ENT,"^",3)
if X<1!(X>10)
SET X=10
XECUTE ^%ZOSF("PRIORITY")
+5 IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+6 SET HTIME=+$PIECE($GET(^RGEQASN(+$ORDER(^RGEQASN("B",TYPE,0)),0)),"^",4)
+7 if HTIME<30
SET HTIME=30
+8 SET CURTIME=0
+9 FOR
if $$ESTOP^RGEQDMN1(TYPE)!(CURTIME'<HTIME)
QUIT
Begin DoDot:1
+10 MERGE ^RGEQ(TYPE)=^RGEQ("ADQ",TYPE)
+11 KILL ^RGEQ("ADQ")
+12 IF $ORDER(^RGEQ(TYPE,""))]""
DO PROCESS
SET CURTIME=0
QUIT
+13 SET CURTIME=CURTIME+5
+14 HANG 5
+15 QUIT
End DoDot:1
+16 LOCK -^RGEQ(TYPE)
+17 KILL TYPE
QUIT
PROCESS ;
+1 SET PARAM=""
SET STAT=$$ENT^RGEQSTAT(TYPE)
SET HORLOG=+$HOROLOG
+2 SET PROG=$PIECE($GET(^RGEQASN(+$ORDER(^RGEQASN("B",TYPE,0)),1)),"^",1,2)
+3 IF PROG=""
SET PROG="EVENT TYPE DOES NOT EXIST"
+4 IF '$TEST
Begin DoDot:1
+5 SET X=$PIECE(PROG,"^",2)
+6 IF X=""
SET PROG="INVALID PROGRAM NAME"
+7 IF '$TEST
Begin DoDot:2
+8 XECUTE ^%ZOSF("TEST")
+9 IF '$TEST
SET PROG="PROGRAM DOES NOT EXIST"
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 FOR
SET PARAM=$ORDER(^RGEQ(TYPE,PARAM))
if PARAM=""
QUIT
Begin DoDot:1
+13 IF +$HOROLOG'=HORLOG
SET STAT=$$ENT^RGEQSTAT(TYPE)
SET HORLOG=+$HOROLOG
+14 IF PROG'["^"
Begin DoDot:2
+15 DO SET^RGEQEXC(TYPE,PROG,PARAM)
+16 KILL ^RGEQ(TYPE,PARAM)
+17 SET $PIECE(^RGSTAT(995.2,STAT,1),"^",2)=$PIECE($GET(^RGSTAT(995.2,STAT,1)),"^",2)+1
+18 QUIT
End DoDot:2
QUIT
+19 SET X="ERROR^RGEQSUB"
SET @^%ZOSF("TRAP")
SET ERROR=""
+20 DO START^RGHLLOG(,TYPE,PARAM)
+21 SET ^RGEQ("ADQ",TYPE,PARAM)=""
+22 KILL ^RGEQ(TYPE,PARAM)
+23 DO @(PROG_"("""_TYPE_""","""_PARAM_""",.ERROR,"""_$PIECE(ENT,"^",2)_""")")
+24 IF ERROR=""
SET $PIECE(^RGSTAT(995.2,STAT,1),"^")=$PIECE($GET(^RGSTAT(995.2,STAT,1)),"^")+1
+25 IF ERROR]""
Begin DoDot:2
+26 SET $PIECE(^RGSTAT(995.2,STAT,1),"^",2)=$PIECE($GET(^RGSTAT(995.2,STAT,1)),"^",2)+1
+27 DO EXC^RGHLLOG(ERROR)
DO SET^RGEQEXC(TYPE,ERROR,PARAM)
+28 QUIT
End DoDot:2
+29 KILL ^RGEQ("ADQ",TYPE,PARAM)
+30 DO STOP^RGHLLOG(0)
+31 QUIT
End DoDot:1
+32 QUIT
ERROR ;Come here on application error
+1 NEW ERROR
+2 SET ERROR=$$EC^%ZOSV
+3 SET $PIECE(^RGSTAT(995.2,STAT,1),"^",2)=$PIECE($GET(^RGSTAT(995.2,STAT,1)),"^",2)+1
+4 DO EXC^RGHLLOG(6,ERROR)
DO SET^RGEQEXC(TYPE,ERROR,PARAM)
+5 KILL ^RGEQ("ADQ",TYPE,PARAM),^RGEQ(TYPE,PARAM)
+6 DO STOP^RGHLLOG(1)
DO ^%ZTER
+7 QUIT
