RABUL ;HISC/FPT,GJC AISC/DMK-Generate 'RAD/NUC MED REQUEST CANCELLED' or 'RAD/NUC MED REQUEST HELD' Bulletin ;16 Jun 2017 2:27 PM
;;5.0;Radiology/Nuclear Medicine;**2,15,75,135**;Mar 16, 1998;Build 7
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; The variables DA and RAOSTS must be defined.
; The variable DA must be greater than 0, and RAOSTS must
; equal 1 (cancelled) or 3 (held) for the RAD/NUC MED REQUEST CANCELLED
; or the RAD/NUC MED REQUEST HELD bulletin to execute.
; Called from: ^DD(75.1,5,0) fifth piece
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ***** Variable List *****
; 'RADFN' -> IEN of the patient in the PATIENT file (2)
; 'RAFN1' -> internal format of a FM date/time data element
; 'RAFN2' -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
; 'Z' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE ORDERS
; file (75.1)
; Format: Data to be fired;local var name;XMB array representation
; Patient ; RANAME ; XMB(1) <---> Req. Physician ; RARPHY ; XMB(5)
; Patient SSN ; RASSN ; XMB(2) <---> Req. Location ; RARLOC ; XMB(6)
; Procedure ; RAPNAM ; XMB(3) <---> Reason ; RARCR ; XMB(7)
; Date Desired ; RADTDS ; XMB(4) <---> Current User ; RAUSER ; XMB(8)
;
EN(RAX) ; Pass in the request status (RAX)
; also called during request status edit.
Q:+$G(DA)'>0 Q:$G(RA135TIME)=1 ;RA5P135
Q:+$G(RAOSTS)'=1&(+$G(RAOSTS)'=3)
N RADFN,RADTDS,RAFN1,RAFN2,RASSN,RAUSER,RAXMB,Z
S RAXMB="RAD/NUC MED REQUEST",Z=$G(^RAO(75.1,DA,0))
S (RADFN,RANAME)=+$P(Z,U)
S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
S RASSN=$$SSN^RAUTL(),RAPNAM=+$P(Z,U,2)
S RAPNAM=$S($D(^RAMIS(71,RAPNAM,0)):$P(^(0),U),1:"Unknown")
S RARLOC=+$P(Z,U,22)
S RARLOC=$S($D(^SC(RARLOC,0)):$P(^(0),U),1:"Unknown")
S RAFN1=$P(Z,U,21),RAFN2=$P($G(^DD(75.1,21,0)),U,2)
S RADTDS=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
S:RADTDS']"" RADTDS="Unknown" S RARPHY=+$P(Z,U,14)
S RARPHY=$S($D(^VA(200,RARPHY,0)):$P(^(0),U),1:"Unknown")
S RARCR=+$P(Z,U,10)
S RARCR=$S($D(^RA(75.2,RARCR,0)):$P(^(0),U),1:"Unknown")
S:RARCR="Unknown" RARCR=$S($P(Z,U,27)]"":$P(Z,U,27),1:"Unknown")
S RAUSER=$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"Unknown")
; --- P75 define the REASON FOR STUDY ---
S RASTYREA=$P($G(^RAO(75.1,DA,.1)),U)
S:RASTYREA="" RASTYREA="Unknown" ;req'd if missing error
;
S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RAPNAM,XMB(4)=RASTYREA,XMB(5)=RADTDS
S XMB(6)=RARPHY,XMB(7)=RARLOC,XMB(8)=RARCR,XMB(9)=RAUSER
S XMB=RAXMB_$S(RAX=1:" CANCELLED",1:" HELD")
D ^XMB:$D(^XMB(3.6,"B",XMB))
K RANAME,RAPNAM,RARLOC,RARPHY,RARCR,RASTYREA,XMB,XMB0,XMC0,XMDT,XMM,XMMG
Q
OE3(DA) ; Trigger the Rad/Nuc Med Request Cancelled bulletin when
; the order is discontinued through CPRS (frontdoor).
; Input: DA-ien of the Rad/Nuc Med order record
S RAOSTS=$P($G(^RAO(75.1,DA,0)),"^",5)
I RAOSTS'=1 K RAOSTS Q ; status must be discontinued
D EN(RAOSTS) K RAOSTS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABUL 3014 printed Nov 22, 2024@17:43:50 Page 2
RABUL ;HISC/FPT,GJC AISC/DMK-Generate 'RAD/NUC MED REQUEST CANCELLED' or 'RAD/NUC MED REQUEST HELD' Bulletin ;16 Jun 2017 2:27 PM
+1 ;;5.0;Radiology/Nuclear Medicine;**2,15,75,135**;Mar 16, 1998;Build 7
+2 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+3 ; The variables DA and RAOSTS must be defined.
+4 ; The variable DA must be greater than 0, and RAOSTS must
+5 ; equal 1 (cancelled) or 3 (held) for the RAD/NUC MED REQUEST CANCELLED
+6 ; or the RAD/NUC MED REQUEST HELD bulletin to execute.
+7 ; Called from: ^DD(75.1,5,0) fifth piece
+8 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+9 ; ***** Variable List *****
+10 ; 'RADFN' -> IEN of the patient in the PATIENT file (2)
+11 ; 'RAFN1' -> internal format of a FM date/time data element
+12 ; 'RAFN2' -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
+13 ; 'Z' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE ORDERS
+14 ; file (75.1)
+15 ; Format: Data to be fired;local var name;XMB array representation
+16 ; Patient ; RANAME ; XMB(1) <---> Req. Physician ; RARPHY ; XMB(5)
+17 ; Patient SSN ; RASSN ; XMB(2) <---> Req. Location ; RARLOC ; XMB(6)
+18 ; Procedure ; RAPNAM ; XMB(3) <---> Reason ; RARCR ; XMB(7)
+19 ; Date Desired ; RADTDS ; XMB(4) <---> Current User ; RAUSER ; XMB(8)
+20 ;
EN(RAX) ; Pass in the request status (RAX)
+1 ; also called during request status edit.
+2 ;RA5P135
if +$GET(DA)'>0
QUIT
if $GET(RA135TIME)=1
QUIT
+3 if +$GET(RAOSTS)'=1&(+$GET(RAOSTS)'=3)
QUIT
+4 NEW RADFN,RADTDS,RAFN1,RAFN2,RASSN,RAUSER,RAXMB,Z
+5 SET RAXMB="RAD/NUC MED REQUEST"
SET Z=$GET(^RAO(75.1,DA,0))
+6 SET (RADFN,RANAME)=+$PIECE(Z,U)
+7 SET RANAME=$SELECT($DATA(^DPT(RANAME,0)):$PIECE(^(0),U),1:"Unknown")
+8 SET RASSN=$$SSN^RAUTL()
SET RAPNAM=+$PIECE(Z,U,2)
+9 SET RAPNAM=$SELECT($DATA(^RAMIS(71,RAPNAM,0)):$PIECE(^(0),U),1:"Unknown")
+10 SET RARLOC=+$PIECE(Z,U,22)
+11 SET RARLOC=$SELECT($DATA(^SC(RARLOC,0)):$PIECE(^(0),U),1:"Unknown")
+12 SET RAFN1=$PIECE(Z,U,21)
SET RAFN2=$PIECE($GET(^DD(75.1,21,0)),U,2)
+13 SET RADTDS=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
+14 if RADTDS']""
SET RADTDS="Unknown"
SET RARPHY=+$PIECE(Z,U,14)
+15 SET RARPHY=$SELECT($DATA(^VA(200,RARPHY,0)):$PIECE(^(0),U),1:"Unknown")
+16 SET RARCR=+$PIECE(Z,U,10)
+17 SET RARCR=$SELECT($DATA(^RA(75.2,RARCR,0)):$PIECE(^(0),U),1:"Unknown")
+18 if RARCR="Unknown"
SET RARCR=$SELECT($PIECE(Z,U,27)]"":$PIECE(Z,U,27),1:"Unknown")
+19 SET RAUSER=$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"Unknown")
+20 ; --- P75 define the REASON FOR STUDY ---
+21 SET RASTYREA=$PIECE($GET(^RAO(75.1,DA,.1)),U)
+22 ;req'd if missing error
if RASTYREA=""
SET RASTYREA="Unknown"
+23 ;
+24 SET XMB(1)=RANAME
SET XMB(2)=RASSN
SET XMB(3)=RAPNAM
SET XMB(4)=RASTYREA
SET XMB(5)=RADTDS
+25 SET XMB(6)=RARPHY
SET XMB(7)=RARLOC
SET XMB(8)=RARCR
SET XMB(9)=RAUSER
+26 SET XMB=RAXMB_$SELECT(RAX=1:" CANCELLED",1:" HELD")
+27 if $DATA(^XMB(3.6,"B",XMB))
DO ^XMB
+28 KILL RANAME,RAPNAM,RARLOC,RARPHY,RARCR,RASTYREA,XMB,XMB0,XMC0,XMDT,XMM,XMMG
+29 QUIT
OE3(DA) ; Trigger the Rad/Nuc Med Request Cancelled bulletin when
+1 ; the order is discontinued through CPRS (frontdoor).
+2 ; Input: DA-ien of the Rad/Nuc Med order record
+3 SET RAOSTS=$PIECE($GET(^RAO(75.1,DA,0)),"^",5)
+4 ; status must be discontinued
IF RAOSTS'=1
KILL RAOSTS
QUIT
+5 DO EN(RAOSTS)
KILL RAOSTS
+6 QUIT
