- 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 Feb 18, 2025@23:08:01 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
