Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RABUL1

RABUL1.m

Go to the documentation of this file. 
  1. RABUL1 ;HISC/FPT,GJC-'RAD/NUC MED EXAM DELETED' Bulletin ;10/24/94  15:22
  1.  ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1.  ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1.  ; The DA array and RABULL must be defined.
  1.  ; The elements of the DA array must be greater than 0, and RABULL must
  1.  ; exist for the RAD/NUC MED EXAM DELETED bulletin to execute.
  1.  ; Note: This routine is closely related to the code at: ASKDEL^RAEDCN
  1.  ; Called from: ^DD(70.03,.01,1,2,0-"DT") xref nodes
  1.  ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1.  ;                     ***** Variable List *****
  1.  ; 'DIFQ'   -> Variable used check if we are installing the Radiology
  1.  ;             Package.  If we are, do not fire the bulletins.
  1.  ; 'RABULL' -> Flag to send bulletin, defined in ASKDEL^RAEDCN
  1.  ; 'RADFN'  -> IEN of the patient in the PATIENT file (2)
  1.  ; 'RAFN1'  -> internal format of a FM date/time data element
  1.  ;             { internal format pointer value }
  1.  ; 'RAFN2'  -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
  1.  ; 'A'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
  1.  ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),"P",DA,0) }
  1.  ; 'B'      -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE PATIENT
  1.  ;             file (70) { node: ^RADPT(DA(2),"DT",DA(1),0) }
  1.  ; 'C'      -> Zero node of the RADIOLOGY PATIENT/NUCLEAR MEDICINE
  1.  ;             file (70) { node: ^RADPT(DA(2),0) }
  1.  ;
  1.  ; Format: Data to be fired;local var name;XMB array representation
  1.  ; Patient ; RANAME ; XMB(1)     <---> Req. Date ; RARDT ; XMB(5)
  1.  ; Patient SSN ; RASSN ; XMB(2)  <---> Rad. Location ; RARLOC ; XMB(6)
  1.  ; Case Number ; RACASE ; XMB(3) <---> Rad. Procedure ; RARPROC ; XMB(7)
  1.  ; Exam Date ; RAXDT ; XMB(4)
  1.  ;
  1.  Q:$D(DIFQ)  ; Quit if installing the software
  1.  Q:'$D(RABULL)!(+$G(DA(2))'>0)!(+$G(DA(1))'>0)!(+$G(DA)'>0)
  1.  N A,B,C,RACASE,RADFN,RAFN1,RAFN2,RANAME,RARDT,RARLOC,RARPROC,RASSN
  1.  N RAXDT,X,Y
  1.  S A=$G(^RADPT(DA(2),"DT",DA(1),"P",DA,0))
  1.  S B=$G(^RADPT(DA(2),"DT",DA(1),0))
  1.  S C=$G(^RADPT(DA(2),0))
  1.  S (RADFN,RANAME)=+$P(C,U)
  1.  S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
  1.  S RASSN=$$SSN^RAUTL()
  1.  S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")
  1.  S RAFN1=$P(B,U),RAFN2=$P($G(^DD(70.02,.01,0)),U,2)
  1.  S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
  1.  S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")
  1.  S RAFN1=$P(A,U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)
  1.  S RARDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
  1.  S RARDT=$S(RARDT]"":RARDT,1:"Unknown")
  1.  S RAFN1=$P(B,U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)
  1.  S RARLOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
  1.  S RARLOC=$S(RARLOC]"":RARLOC,1:"Unknown")
  1.  S RAFN1=$P(A,U,2),RAFN2=$P($G(^DD(70.03,2,0)),U,2)
  1.  S RARPROC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
  1.  S RARPROC=$S(RARPROC]"":RARPROC,1:"Unknown")
  1.  S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE,XMB(4)=RAXDT
  1.  S XMB(5)=RARDT,XMB(6)=RARLOC,XMB(7)=RARPROC
  1.  S XMB="RAD/NUC MED EXAM DELETED"
  1.  D ^XMB:$D(^XMB(3.6,"B",XMB))
  1.  K XMB,XMB0,XMC0,XMDT,XMM,XMMG
  1.  Q