- 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 Feb 19, 2025@00:06:22 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