RGEQEXC ;BHM/RGY-Error processor ;17-Feb-98
;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
SET(TYPE,ERROR,STUB) ;Receive Error
NEW DIC,D0,DIE,DA,X,DLAYGO,DR,RGOK,EVN
I $G(TYPE)="" G Q
I TYPE'?1N.N S TYPE=$O(^RGEQASN("B",TYPE,0)) I TYPE="" G Q
F EVN=+$P(^RGEQEXC(0),"^",3)+1:1 L +^RGEQEXC(EVN):0 I $T S RGOK=0 D L -^RGEQEXC(EVN) Q:RGOK
.I $D(^RGEQEXC(EVN)) Q
.S DINUM=EVN,DIC="^RGEQEXC(",DIC(0)="L",DLAYGO=995.1,X=EVN K DD,D0 D FILE^DICN K DIC,DLAYGO,D0
.S DIE="^RGEQEXC(",DR="[RGEQ NEW EXCEPTION]",DA=EVN D ^DIE
.S RGOK=1
.Q
Q Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEQEXC 566 printed Dec 13, 2024@01:41:36 Page 2
RGEQEXC ;BHM/RGY-Error processor ;17-Feb-98
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
SET(TYPE,ERROR,STUB) ;Receive Error
+1 NEW DIC,D0,DIE,DA,X,DLAYGO,DR,RGOK,EVN
+2 IF $GET(TYPE)=""
GOTO Q
+3 IF TYPE'?1N.N
SET TYPE=$ORDER(^RGEQASN("B",TYPE,0))
IF TYPE=""
GOTO Q
+4 FOR EVN=+$PIECE(^RGEQEXC(0),"^",3)+1:1
LOCK +^RGEQEXC(EVN):0
IF $TEST
SET RGOK=0
Begin DoDot:1
+5 IF $DATA(^RGEQEXC(EVN))
QUIT
+6 SET DINUM=EVN
SET DIC="^RGEQEXC("
SET DIC(0)="L"
SET DLAYGO=995.1
SET X=EVN
KILL DD,D0
DO FILE^DICN
KILL DIC,DLAYGO,D0
+7 SET DIE="^RGEQEXC("
SET DR="[RGEQ NEW EXCEPTION]"
SET DA=EVN
DO ^DIE
+8 SET RGOK=1
+9 QUIT
End DoDot:1
LOCK -^RGEQEXC(EVN)
if RGOK
QUIT
Q QUIT
