RAUTL0 ;HISC/CAH,FPT,GJC-Utility Routine ;11/5/99 13:19
;;5.0;Radiology/Nuclear Medicine;**2,13,10,71**;Mar 16, 1998;Build 10
; 07/05/2006 BAY/KAM Remedy Call 124379 Patch RA*5*71
UPSTAT ;QUEUE ONE REPORT TO UPDATE STATUS
;07/05/2006 BAY/KAM/GJC If RAHLTCPB is defined, do not broadcast ORM messages. RAHLTCPB is referenced in UP2^RAUTL1
;which is called from UP1^RAUTL1
N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
S ZTRTN="STAT^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
S ZTDTH=$H,ZTDESC="Rad/Nuc Med UPDATE STATUS OF ONE REPORT" S SDUZ=$G(RADUZ) S:'SDUZ SDUZ=DUZ F I="RAMDIV","RAMDV","RARPT","RAONLINE","RAAB","RAMLC","RAIMGTY","SDUZ" S ZTSAVE(I)=""
S:$G(RADUZ) ZTSAVE("RADUZ")="" ;rpt may be verified by voice
; 07/05/2006 BAY/KAM Added next line
S:$G(RAHLTCPB) ZTSAVE("RAHLTCPB")="" ;rpt v'fied by VR; do not broadcast ORM messages.
D ^%ZTLOAD K SDUZ
I $D(ZTSK),'$D(RAQUEUED) W !,?5,"Status update queued!",! R X:2
Q
;
;Set off a series of actions as a result of report update: ;ch
; patient loc updated in Rpt Distrib file #74.4
; can also cause rec to be added to file 74.4 (depending on category
; of exam
; update status of exam if possible and do accompanying actions (such
; as update of status log if specified in div params, notify OE/RR,
; change order status if necessary, can also cause alerts to be
; fired off)
STAT ;TASKMAN ENTRY POINT TO UPDATE STATUS OF ONE REPORT
N RASAVE ; array to save off RADFN, RADTI & RACNI
S RAF1=1,Y=RARPT D RASET^RAUTL2,UP1^RAUTL1,STUFF^RARTST
S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
S RAEXFLD="ALL",D0=RARPT
D ^RARTFLDS,OENOTE^RAUTL00 ; OENOTE replaces STAT1
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
UPSTATM ;QUEUE MULTIPLE REPORTS TO UPDATE STATUSES
N RAIO S RAIO=+$P($G(^RA(79,+RAMDIV,"RDEV")),"^") ; Resource Device?
S ZTRTN="STATM^RAUTL0",ZTIO=$S(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
S ZTDTH=$H,ZTDESC="Rad/Nuc Med UPDATE STATUSES OF MULTIPLE REPORTS" S SDUZ=$G(RADUZ) S:'SDUZ SDUZ=DUZ F I="^TMP($J,""RA"",""DT"",","RAMDV","RAMDIV","RAONLINE","RAMLC","RAIMGTY","SDUZ" S ZTSAVE(I)=""
D ^%ZTLOAD K SDUZ I $D(ZTSK) W !,?5,"Status updates queued!",!
Q
;
STATM ;TASKMAN ENTRY POINT TO UPDATE STATUSES OF MULTIPLE REPORTS
S RAF1=1 F RARTDT=0:0 S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT'>0 F RA1=0:0 S RA1=$O(^TMP($J,"RA","DT",RARTDT,RA1)) Q:RA1'>0 S (RARPT,Y)=RA1 D RASET^RAUTL2,UP1^RAUTL1,STUFF^RARTST,STATM1
I $D(ZTQUEUED) S ZTREQ="@"
Q
STATM1 ; Update statuses of multiple reports
N RASAVE ; array to save off RADFN, RADTI & RACNI
S:^TMP($J,"RA","DT",RARTDT,RA1) RAAB=1
S RASAVE("RADFN")=RADFN,RASAVE("RADTI")=RADTI,RASAVE("RACNI")=RACNI
S:$$ORVR^RAORDU()=2.5 ORVP=RADFN_";DPT(",ORBXDATA=RARPT
S RAEXFLD="ALL",D0=RARPT D ^RARTFLDS
D OENOTE^RAUTL00 K RAAB,ORIFN,ORNOTE
Q
;
EN ;Entry point to credit x-ray clinic stops
I $$PCE^RAWORK Q
S RASDC="" I '$D(RAMDIV)!'$D(RADTE)!'$D(RADFN)!'$D(RAPRIT)!'$D(RAMLC) G NOGO
S SDIV=RAMDIV,SDATE=$P(RADTE,"."),DFN=RADFN,SDC="",SDMSG="S"
G NOGO:'$D(^RAMIS(71,+RAPRIT,0)) S X=+$P(^(0),"^",9)
S X=$S(X="":"",1:$P($$NAMCODE^RACPTMSC(X,DT),"^"))
I X S X1=$S($D(^RA(79.1,+RAMLC,"PC")):^("PC"),1:"") G NOGO:'X1 S SDCPT(1)="900^"_X1_"^"_X
I $O(^RAMIS(71,RAPRIT,"STOP",0)) F I=0:0 S I=$O(^RAMIS(71,RAPRIT,"STOP",I)) Q:I'>0 I $D(^RAMIS(71,RAPRIT,"STOP",I,0)) S J=+^(0) D CON
S SDCTYPE=$S($D(SDCPT(1)):"B",1:"S") W:'$D(ZTQUEUED) !!?5,"Attempting to credit a clinic stop.",! D EN3^SDACS I SDERR=1 G NOGO
S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",24)="Y" W:'$D(ZTQUEUED) !?5,"Clinic Stop credited." G EXIT
;
CON S K=$S($D(^DIC(40.7,+J,0)):$P(^(0),"^",2),1:"") I K S:SDC'[K SDC=K_"^"_SDC S RASDC=SDC
Q
;
NOGO W:'$D(ZTQUEUED) *7,!?5,"Unable to credit a clinic stop!",!
I $D(RASDC),($D(DUZ)#2),($D(RADFN)),($D(RADTI)),($D(RACNI)) D
. D STPCDE(RASDC,DUZ,RADFN,RADTI,RACNI) ; Stop Code Error bulletin
. Q
EXIT K I,J,K,RAPR,RASDC,SDC,SDCPT,SDCTYPE,SDERR,SDATE,SDIV,X,X1 Q
;
STPCDE(RA0,RA1,RA2,RA3,RA4) ; Bulletin for Stop Code Credit error
; RA0 -> stop code numbers seperated by "^"'s (if not null)
; RA1 -> Rad/Nuc Med user (DUZ) RA2 -> Patient (RADFN)
; RA3 -> Inverse Xam D/T (RADTI) RA4 -> Exam node (RACNI)
Q:'$D(^VA(200,RA1,0))#2 ; invalid user info
Q:'$D(^RADPT(RA2,"DT",RA3,"P",RA4,0))#2 ; exam info incomplete
N RACASE,RADFN,RACPT,RALENFLG,RAI,RAPAT,RAPROC,RAREGX,RASSN,RASTOP
N RAUSER,RAXAM,RAXDT,XMB S RALENFLG=0
S RAUSER=$P($G(^VA(200,RA1,0)),"^"),RADFN=RA2
S RASSN=$$SSN^RAUTL(),RAREGX=$G(^RADPT(RA2,"DT",RA3,0))
S RAXAM=$G(^RADPT(RA2,"DT",RA3,"P",RA4,0)),RACASE=$P(RAXAM,"^")
S RAXDT=$P(RAREGX,"^"),RAPAT=$P($G(^DPT(RA2,0)),"^")
S RAPROC(0)=$G(^RAMIS(71,+$P(RAXAM,"^",2),0))
;S RACPT(0)=$G(^ICPT(+$P(RAPROC(0),"^",9),0)),RACPT=$P(RACPT(0),"^")
;S RACPT(4)=+$P(RACPT(0),"^",4),RACPT=$S(RACPT]"":RACPT,1:"Unknown")
;I RACPT(4),(RACPT]"") S RACPT=RACPT_" (invalid)"
S RACPT(0)=+$P(RAPROC(0),"^",9) ;ien to file 81
S RACPT=$P($$NAMCODE^RACPTMSC(RACPT(0),RAXDT),"^") ;.01 value file 81
S RACPT(4)=$$ACTCODE^RACPTMSC(RACPT(0),RAXDT) ;1=active,0=inactive
I RACPT']"" S RACPT="Unknown"
I 'RACPT(4),(RACPT'="Unknown") S RACPT=RACPT_" (invalid)"
S RAPROC=$E($P(RAPROC(0),"^"),1,45)
S RAPROC=$S(RAPROC]"":RAPROC,1:"Unknown")
I RA0']""!(RA0?1."^") D
. N RAPC S RAPC=+$P($G(^RA(79.1,+RAMLC,"PC")),"^")
. S:RAPC RASTOP="Missing STOP CODE data"
. S:'RAPC RASTOP="No Principal Clinic entered for '"_$P($G(^SC(+$P($G(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'."
. Q
E D
. S RASTOP="" F RAI=1:1:$L(RA0,"^") D Q:RALENFLG
.. S RASTOP(2)=$P(RA0,"^",RAI) Q:RASTOP(2)']""
.. S RASTOP(1)=$P($G(^DIC(40.7,+$O(^DIC(40.7,"C",RASTOP(2),0)),0)),"^")
.. S RASTOP(3)=RASTOP(2)_" "_RASTOP(1)_", "
.. I ($L(RASTOP)+$L(RASTOP(3)))>512 S RALENFLG=1 Q:RALENFLG
.. S RASTOP=RASTOP_RASTOP(3)
.. Q
. I $P(RASTOP,", ",$L(RASTOP,", "))']"" D
.. S RASTOP=$P(RASTOP,", ",1,$L(RASTOP,", ")-1)
.. Q
. Q
; XMB(1) -> Full patient name XMB(2) -> patient SSN
; XMB(3) -> Examination Date XMB(4) -> Case Number
; XMB(5) -> Procedure XMB(6) -> CPT Code
; XMB(7) -> Stop Code(s) XMB(8) -> Rad/Nuc Med user
S XMB(1)=RAPAT,XMB(2)=RASSN,XMB(3)=$$FMTE^XLFDT(RAXDT),XMB(4)=RACASE
S XMB(5)=RAPROC,XMB(6)=RACPT,XMB(7)=RASTOP,XMB(8)=RAUSER
S XMB="RAD/NUC MED CREDIT STOP ERROR"
D ^XMB:$D(^XMB(3.6,"B",XMB))
K XMB0,XMC0,XMDT,XMM,XMMG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAUTL0 6599 printed Oct 16, 2024@18:40:41 Page 2
RAUTL0 ;HISC/CAH,FPT,GJC-Utility Routine ;11/5/99 13:19
+1 ;;5.0;Radiology/Nuclear Medicine;**2,13,10,71**;Mar 16, 1998;Build 10
+2 ; 07/05/2006 BAY/KAM Remedy Call 124379 Patch RA*5*71
UPSTAT ;QUEUE ONE REPORT TO UPDATE STATUS
+1 ;07/05/2006 BAY/KAM/GJC If RAHLTCPB is defined, do not broadcast ORM messages. RAHLTCPB is referenced in UP2^RAUTL1
+2 ;which is called from UP1^RAUTL1
+3 ; Resource Device?
NEW RAIO
SET RAIO=+$PIECE($GET(^RA(79,+RAMDIV,"RDEV")),"^")
+4 SET ZTRTN="STAT^RAUTL0"
SET ZTIO=$SELECT(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
+5 SET ZTDTH=$HOROLOG
SET ZTDESC="Rad/Nuc Med UPDATE STATUS OF ONE REPORT"
SET SDUZ=$GET(RADUZ)
if 'SDUZ
SET SDUZ=DUZ
FOR I="RAMDIV","RAMDV","RARPT","RAONLINE","RAAB","RAMLC","RAIMGTY","SDUZ"
SET ZTSAVE(I)=""
+6 ;rpt may be verified by voice
if $GET(RADUZ)
SET ZTSAVE("RADUZ")=""
+7 ; 07/05/2006 BAY/KAM Added next line
+8 ;rpt v'fied by VR; do not broadcast ORM messages.
if $GET(RAHLTCPB)
SET ZTSAVE("RAHLTCPB")=""
+9 DO ^%ZTLOAD
KILL SDUZ
+10 IF $DATA(ZTSK)
IF '$DATA(RAQUEUED)
WRITE !,?5,"Status update queued!",!
READ X:2
+11 QUIT
+12 ;
+13 ;Set off a series of actions as a result of report update: ;ch
+14 ; patient loc updated in Rpt Distrib file #74.4
+15 ; can also cause rec to be added to file 74.4 (depending on category
+16 ; of exam
+17 ; update status of exam if possible and do accompanying actions (such
+18 ; as update of status log if specified in div params, notify OE/RR,
+19 ; change order status if necessary, can also cause alerts to be
+20 ; fired off)
STAT ;TASKMAN ENTRY POINT TO UPDATE STATUS OF ONE REPORT
+1 ; array to save off RADFN, RADTI & RACNI
NEW RASAVE
+2 SET RAF1=1
SET Y=RARPT
DO RASET^RAUTL2
DO UP1^RAUTL1
DO STUFF^RARTST
+3 SET RASAVE("RADFN")=RADFN
SET RASAVE("RADTI")=RADTI
SET RASAVE("RACNI")=RACNI
+4 if $$ORVR^RAORDU()=2.5
SET ORVP=RADFN_";DPT("
SET ORBXDATA=RARPT
+5 SET RAEXFLD="ALL"
SET D0=RARPT
+6 ; OENOTE replaces STAT1
DO ^RARTFLDS
DO OENOTE^RAUTL00
+7 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
+9 ;
UPSTATM ;QUEUE MULTIPLE REPORTS TO UPDATE STATUSES
+1 ; Resource Device?
NEW RAIO
SET RAIO=+$PIECE($GET(^RA(79,+RAMDIV,"RDEV")),"^")
+2 SET ZTRTN="STATM^RAUTL0"
SET ZTIO=$SELECT(RAIO>0:$$GET1^DIQ(3.5,RAIO_",",.01),1:"")
+3 SET ZTDTH=$HOROLOG
SET ZTDESC="Rad/Nuc Med UPDATE STATUSES OF MULTIPLE REPORTS"
SET SDUZ=$GET(RADUZ)
if 'SDUZ
SET SDUZ=DUZ
FOR I="^TMP($J,""RA"",""DT"",","RAMDV","RAMDIV","RAONLINE","RAMLC","RAIMGTY","SDUZ"
SET ZTSAVE(I)=""
+4 DO ^%ZTLOAD
KILL SDUZ
IF $DATA(ZTSK)
WRITE !,?5,"Status updates queued!",!
+5 QUIT
+6 ;
STATM ;TASKMAN ENTRY POINT TO UPDATE STATUSES OF MULTIPLE REPORTS
+1 SET RAF1=1
FOR RARTDT=0:0
SET RARTDT=$ORDER(^TMP($JOB,"RA","DT",RARTDT))
if RARTDT'>0
QUIT
FOR RA1=0:0
SET RA1=$ORDER(^TMP($JOB,"RA","DT",RARTDT,RA1))
if RA1'>0
QUIT
SET (RARPT,Y)=RA1
DO RASET^RAUTL2
DO UP1^RAUTL1
DO STUFF^RARTST
DO STATM1
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
STATM1 ; Update statuses of multiple reports
+1 ; array to save off RADFN, RADTI & RACNI
NEW RASAVE
+2 if ^TMP($JOB,"RA","DT",RARTDT,RA1)
SET RAAB=1
+3 SET RASAVE("RADFN")=RADFN
SET RASAVE("RADTI")=RADTI
SET RASAVE("RACNI")=RACNI
+4 if $$ORVR^RAORDU()=2.5
SET ORVP=RADFN_";DPT("
SET ORBXDATA=RARPT
+5 SET RAEXFLD="ALL"
SET D0=RARPT
DO ^RARTFLDS
+6 DO OENOTE^RAUTL00
KILL RAAB,ORIFN,ORNOTE
+7 QUIT
+8 ;
EN ;Entry point to credit x-ray clinic stops
+1 IF $$PCE^RAWORK
QUIT
+2 SET RASDC=""
IF '$DATA(RAMDIV)!'$DATA(RADTE)!'$DATA(RADFN)!'$DATA(RAPRIT)!'$DATA(RAMLC)
GOTO NOGO
+3 SET SDIV=RAMDIV
SET SDATE=$PIECE(RADTE,".")
SET DFN=RADFN
SET SDC=""
SET SDMSG="S"
+4 if '$DATA(^RAMIS(71,+RAPRIT,0))
GOTO NOGO
SET X=+$PIECE(^(0),"^",9)
+5 SET X=$SELECT(X="":"",1:$PIECE($$NAMCODE^RACPTMSC(X,DT),"^"))
+6 IF X
SET X1=$SELECT($DATA(^RA(79.1,+RAMLC,"PC")):^("PC"),1:"")
if 'X1
GOTO NOGO
SET SDCPT(1)="900^"_X1_"^"_X
+7 IF $ORDER(^RAMIS(71,RAPRIT,"STOP",0))
FOR I=0:0
SET I=$ORDER(^RAMIS(71,RAPRIT,"STOP",I))
if I'>0
QUIT
IF $DATA(^RAMIS(71,RAPRIT,"STOP",I,0))
SET J=+^(0)
DO CON
+8 SET SDCTYPE=$SELECT($DATA(SDCPT(1)):"B",1:"S")
if '$DATA(ZTQUEUED)
WRITE !!?5,"Attempting to credit a clinic stop.",!
DO EN3^SDACS
IF SDERR=1
GOTO NOGO
+9 SET $PIECE(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",24)="Y"
if '$DATA(ZTQUEUED)
WRITE !?5,"Clinic Stop credited."
GOTO EXIT
+10 ;
CON SET K=$SELECT($DATA(^DIC(40.7,+J,0)):$PIECE(^(0),"^",2),1:"")
IF K
if SDC'[K
SET SDC=K_"^"_SDC
SET RASDC=SDC
+1 QUIT
+2 ;
NOGO if '$DATA(ZTQUEUED)
WRITE *7,!?5,"Unable to credit a clinic stop!",!
+1 IF $DATA(RASDC)
IF ($DATA(DUZ)#2)
IF ($DATA(RADFN))
IF ($DATA(RADTI))
IF ($DATA(RACNI))
Begin DoDot:1
+2 ; Stop Code Error bulletin
DO STPCDE(RASDC,DUZ,RADFN,RADTI,RACNI)
+3 QUIT
End DoDot:1
EXIT KILL I,J,K,RAPR,RASDC,SDC,SDCPT,SDCTYPE,SDERR,SDATE,SDIV,X,X1
QUIT
+1 ;
STPCDE(RA0,RA1,RA2,RA3,RA4) ; Bulletin for Stop Code Credit error
+1 ; RA0 -> stop code numbers seperated by "^"'s (if not null)
+2 ; RA1 -> Rad/Nuc Med user (DUZ) RA2 -> Patient (RADFN)
+3 ; RA3 -> Inverse Xam D/T (RADTI) RA4 -> Exam node (RACNI)
+4 ; invalid user info
if '$DATA(^VA(200,RA1,0))#2
QUIT
+5 ; exam info incomplete
if '$DATA(^RADPT(RA2,"DT",RA3,"P",RA4,0))#2
QUIT
+6 NEW RACASE,RADFN,RACPT,RALENFLG,RAI,RAPAT,RAPROC,RAREGX,RASSN,RASTOP
+7 NEW RAUSER,RAXAM,RAXDT,XMB
SET RALENFLG=0
+8 SET RAUSER=$PIECE($GET(^VA(200,RA1,0)),"^")
SET RADFN=RA2
+9 SET RASSN=$$SSN^RAUTL()
SET RAREGX=$GET(^RADPT(RA2,"DT",RA3,0))
+10 SET RAXAM=$GET(^RADPT(RA2,"DT",RA3,"P",RA4,0))
SET RACASE=$PIECE(RAXAM,"^")
+11 SET RAXDT=$PIECE(RAREGX,"^")
SET RAPAT=$PIECE($GET(^DPT(RA2,0)),"^")
+12 SET RAPROC(0)=$GET(^RAMIS(71,+$PIECE(RAXAM,"^",2),0))
+13 ;S RACPT(0)=$G(^ICPT(+$P(RAPROC(0),"^",9),0)),RACPT=$P(RACPT(0),"^")
+14 ;S RACPT(4)=+$P(RACPT(0),"^",4),RACPT=$S(RACPT]"":RACPT,1:"Unknown")
+15 ;I RACPT(4),(RACPT]"") S RACPT=RACPT_" (invalid)"
+16 ;ien to file 81
SET RACPT(0)=+$PIECE(RAPROC(0),"^",9)
+17 ;.01 value file 81
SET RACPT=$PIECE($$NAMCODE^RACPTMSC(RACPT(0),RAXDT),"^")
+18 ;1=active,0=inactive
SET RACPT(4)=$$ACTCODE^RACPTMSC(RACPT(0),RAXDT)
+19 IF RACPT']""
SET RACPT="Unknown"
+20 IF 'RACPT(4)
IF (RACPT'="Unknown")
SET RACPT=RACPT_" (invalid)"
+21 SET RAPROC=$EXTRACT($PIECE(RAPROC(0),"^"),1,45)
+22 SET RAPROC=$SELECT(RAPROC]"":RAPROC,1:"Unknown")
+23 IF RA0']""!(RA0?1."^")
Begin DoDot:1
+24 NEW RAPC
SET RAPC=+$PIECE($GET(^RA(79.1,+RAMLC,"PC")),"^")
+25 if RAPC
SET RASTOP="Missing STOP CODE data"
+26 if 'RAPC
SET RASTOP="No Principal Clinic entered for '"_$PIECE($GET(^SC(+$PIECE($GET(^RA(79.1,+RAMLC,0)),"^"),0)),"^")_"'."
+27 QUIT
End DoDot:1
+28 IF '$TEST
Begin DoDot:1
+29 SET RASTOP=""
FOR RAI=1:1:$LENGTH(RA0,"^")
Begin DoDot:2
+30 SET RASTOP(2)=$PIECE(RA0,"^",RAI)
if RASTOP(2)']""
QUIT
+31 SET RASTOP(1)=$PIECE($GET(^DIC(40.7,+$ORDER(^DIC(40.7,"C",RASTOP(2),0)),0)),"^")
+32 SET RASTOP(3)=RASTOP(2)_" "_RASTOP(1)_", "
+33 IF ($LENGTH(RASTOP)+$LENGTH(RASTOP(3)))>512
SET RALENFLG=1
if RALENFLG
QUIT
+34 SET RASTOP=RASTOP_RASTOP(3)
+35 QUIT
End DoDot:2
if RALENFLG
QUIT
+36 IF $PIECE(RASTOP,", ",$LENGTH(RASTOP,", "))']""
Begin DoDot:2
+37 SET RASTOP=$PIECE(RASTOP,", ",1,$LENGTH(RASTOP,", ")-1)
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ; XMB(1) -> Full patient name XMB(2) -> patient SSN
+41 ; XMB(3) -> Examination Date XMB(4) -> Case Number
+42 ; XMB(5) -> Procedure XMB(6) -> CPT Code
+43 ; XMB(7) -> Stop Code(s) XMB(8) -> Rad/Nuc Med user
+44 SET XMB(1)=RAPAT
SET XMB(2)=RASSN
SET XMB(3)=$$FMTE^XLFDT(RAXDT)
SET XMB(4)=RACASE
+45 SET XMB(5)=RAPROC
SET XMB(6)=RACPT
SET XMB(7)=RASTOP
SET XMB(8)=RAUSER
+46 SET XMB="RAD/NUC MED CREDIT STOP ERROR"
+47 if $DATA(^XMB(3.6,"B",XMB))
DO ^XMB
+48 KILL XMB0,XMC0,XMDT,XMM,XMMG
+49 QUIT
