- 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 Feb 18, 2025@23:07:59 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