RABUL1 ;HISC/FPT,GJC-'RAD/NUC MED EXAM DELETED' Bulletin ;10/24/94 15:22
;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; The DA array and RABULL must be defined.
; The elements of the DA array must be greater than 0, and RABULL must
; exist for the RAD/NUC MED EXAM DELETED bulletin to execute.
; Note: This routine is closely related to the code at: ASKDEL^RAEDCN
; Called from: ^DD(70.03,.01,1,2,0-"DT") xref nodes
; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; ***** Variable List *****
; 'DIFQ' -> Variable used check if we are installing the Radiology
; Package. If we are, do not fire the bulletins.
; 'RABULL' -> Flag to send bulletin, defined in ASKDEL^RAEDCN
; 'RADFN' -> IEN of the patient in the PATIENT file (2)
; 'RAFN1' -> internal format of a FM date/time data element
; { internal format pointer value }
; 'RAFN2' -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
; 'A' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
; file (70) { node: ^RADPT(DA(2),"DT",DA(1),"P",DA,0) }
; 'B' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
; file (70) { node: ^RADPT(DA(2),"DT",DA(1),0) }
; 'C' -> Zero node of the RADIOLOGY PATIENT/NUCLEAR MEDICINE
; file (70) { node: ^RADPT(DA(2),0) }
;
; Format: Data to be fired;local var name;XMB array representation
; Patient ; RANAME ; XMB(1) <---> Req. Date ; RARDT ; XMB(5)
; Patient SSN ; RASSN ; XMB(2) <---> Rad. Location ; RARLOC ; XMB(6)
; Case Number ; RACASE ; XMB(3) <---> Rad. Procedure ; RARPROC ; XMB(7)
; Exam Date ; RAXDT ; XMB(4)
;
Q:$D(DIFQ) ; Quit if installing the software
Q:'$D(RABULL)!(+$G(DA(2))'>0)!(+$G(DA(1))'>0)!(+$G(DA)'>0)
N A,B,C,RACASE,RADFN,RAFN1,RAFN2,RANAME,RARDT,RARLOC,RARPROC,RASSN
N RAXDT,X,Y
S A=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
S B=$G(^RADPT(DA(2),"DT",DA(1),0))
S C=$G(^RADPT(DA(2),0))
S (RADFN,RANAME)=+$P(C,U)
S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
S RASSN=$$SSN^RAUTL()
S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")
S RAFN1=$P(B,U),RAFN2=$P($G(^DD(70.02,.01,0)),U,2)
S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")
S RAFN1=$P(A,U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)
S RARDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
S RARDT=$S(RARDT]"":RARDT,1:"Unknown")
S RAFN1=$P(B,U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)
S RARLOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
S RARLOC=$S(RARLOC]"":RARLOC,1:"Unknown")
S RAFN1=$P(A,U,2),RAFN2=$P($G(^DD(70.03,2,0)),U,2)
S RARPROC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
S RARPROC=$S(RARPROC]"":RARPROC,1:"Unknown")
S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE,XMB(4)=RAXDT
S XMB(5)=RARDT,XMB(6)=RARLOC,XMB(7)=RARPROC
S XMB="RAD/NUC MED EXAM DELETED"
D ^XMB:$D(^XMB(3.6,"B",XMB))
K XMB,XMB0,XMC0,XMDT,XMM,XMMG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRABUL1 2992 printed Nov 22, 2024@17:43:51 Page 2
RABUL1 ;HISC/FPT,GJC-'RAD/NUC MED EXAM DELETED' Bulletin ;10/24/94 15:22
+1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
+2 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+3 ; The DA array and RABULL must be defined.
+4 ; The elements of the DA array must be greater than 0, and RABULL must
+5 ; exist for the RAD/NUC MED EXAM DELETED bulletin to execute.
+6 ; Note: This routine is closely related to the code at: ASKDEL^RAEDCN
+7 ; Called from: ^DD(70.03,.01,1,2,0-"DT") xref nodes
+8 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+9 ; ***** Variable List *****
+10 ; 'DIFQ' -> Variable used check if we are installing the Radiology
+11 ; Package. If we are, do not fire the bulletins.
+12 ; 'RABULL' -> Flag to send bulletin, defined in ASKDEL^RAEDCN
+13 ; 'RADFN' -> IEN of the patient in the PATIENT file (2)
+14 ; 'RAFN1' -> internal format of a FM date/time data element
+15 ; { internal format pointer value }
+16 ; 'RAFN2' -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
+17 ; 'A' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
+18 ; file (70) { node: ^RADPT(DA(2),"DT",DA(1),"P",DA,0) }
+19 ; 'B' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
+20 ; file (70) { node: ^RADPT(DA(2),"DT",DA(1),0) }
+21 ; 'C' -> Zero node of the RADIOLOGY PATIENT/NUCLEAR MEDICINE
+22 ; file (70) { node: ^RADPT(DA(2),0) }
+23 ;
+24 ; Format: Data to be fired;local var name;XMB array representation
+25 ; Patient ; RANAME ; XMB(1) <---> Req. Date ; RARDT ; XMB(5)
+26 ; Patient SSN ; RASSN ; XMB(2) <---> Rad. Location ; RARLOC ; XMB(6)
+27 ; Case Number ; RACASE ; XMB(3) <---> Rad. Procedure ; RARPROC ; XMB(7)
+28 ; Exam Date ; RAXDT ; XMB(4)
+29 ;
+30 ; Quit if installing the software
if $DATA(DIFQ)
QUIT
+31 if '$DATA(RABULL)!(+$GET(DA(2))'>0)!(+$GET(DA(1))'>0)!(+$GET(DA)'>0)
QUIT
+32 NEW A,B,C,RACASE,RADFN,RAFN1,RAFN2,RANAME,RARDT,RARLOC,RARPROC,RASSN
+33 NEW RAXDT,X,Y
+34 SET A=$GET(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
+35 SET B=$GET(^RADPT(DA(2),"DT",DA(1),0))
+36 SET C=$GET(^RADPT(DA(2),0))
+37 SET (RADFN,RANAME)=+$PIECE(C,U)
+38 SET RANAME=$SELECT($DATA(^DPT(RANAME,0)):$PIECE(^(0),U),1:"Unknown")
+39 SET RASSN=$$SSN^RAUTL()
+40 SET RACASE=$SELECT($PIECE(A,U)]"":$PIECE(A,U),1:"Unknown")
+41 SET RAFN1=$PIECE(B,U)
SET RAFN2=$PIECE($GET(^DD(70.02,.01,0)),U,2)
+42 SET RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
+43 SET RAXDT=$SELECT(RAXDT]"":RAXDT,1:"Unknown")
+44 SET RAFN1=$PIECE(A,U,21)
SET RAFN2=$PIECE($GET(^DD(70.03,21,0)),U,2)
+45 SET RARDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
+46 SET RARDT=$SELECT(RARDT]"":RARDT,1:"Unknown")
+47 SET RAFN1=$PIECE(B,U,4)
SET RAFN2=$PIECE($GET(^DD(70.02,4,0)),U,2)
+48 SET RARLOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
+49 SET RARLOC=$SELECT(RARLOC]"":RARLOC,1:"Unknown")
+50 SET RAFN1=$PIECE(A,U,2)
SET RAFN2=$PIECE($GET(^DD(70.03,2,0)),U,2)
+51 SET RARPROC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
+52 SET RARPROC=$SELECT(RARPROC]"":RARPROC,1:"Unknown")
+53 SET XMB(1)=RANAME
SET XMB(2)=RASSN
SET XMB(3)=RACASE
SET XMB(4)=RAXDT
+54 SET XMB(5)=RARDT
SET XMB(6)=RARLOC
SET XMB(7)=RARPROC
+55 SET XMB="RAD/NUC MED EXAM DELETED"
+56 if $DATA(^XMB(3.6,"B",XMB))
DO ^XMB
+57 KILL XMB,XMB0,XMC0,XMDT,XMM,XMMG
+58 QUIT
