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