source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABUL3.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1RABUL3 ;HISC/FPT,GJC-'RAD/NUC MED REPORT DELETION' Bulletin ;3/21/95 13:56
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
4 ; The variables DA must be defined. The value of DA must be greater
5 ; than 0. These conditions must exist for the RAD/NUC MED REPORT
6 ; DELETION bulletin to execute.
7 ; Called from: ^DD(74,.01,1,2,0-"DT") xref nodes
8 ; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9 ; ***** Variable List *****
10 ; 'DIFQ' -> Variable used to check if we are installing the
11 ; Radiology Package. If we are, do not fire off
12 ; bulletins.
13 ; 'RADFN' -> IEN of the patient in the PATIENT file (2)
14 ; 'RAEXAM' -> IEN of a record in the Examinations multiple
15 ; of the Radiology/Nuclear Medicine Patient file. (70)
16 ; 'RAEXAM(0)'-> Zero node of a record in the Examinations multiple
17 ; of the Radiology/Nuclear Medicine Patient file. (70)
18 ; 'RARXAM(0)'-> Zero node of a record in the Registered Exam multiple
19 ; of the Radiology/Nuclear Medicine Patient file. (70)
20 ; 'RAFN1' -> internal format of a FM date/time data element
21 ; { internal format pointer value }
22 ; 'RAFN2' -> FM data definition for RAFN1, used in XTERNAL^RAUTL5
23 ; 'A' -> Zero node of the RADIOLOGY/NUCLEAR MEDICINE REPORTS
24 ; file (74) { node: ^RARPT(DA,0) }
25 ;
26 ; Format: Data to be fired;local var name;XMB array representation
27 ; Patient ; RANAME ; XMB(1) <---> Exam Date ; RAXDT ; XMB(4)
28 ; Patient SSN ; RASSN ; XMB(2) <---> Desired Date ; RADDT ; XMB(5)
29 ; Case Number ; RACASE ; XMB(3) <---> Report Status ; RASTAT ; XMB(6)
30 ; Imaging Loc ; RAILOC ; XMB(7)
31 ;
32 Q:$D(DIFQ)!(+$G(DA)'>0) ; Quit if installing software or invalid IEN
33 N A,RACASE,RACN,RADDT,RADTI,RADFN,RAEXAM,RAFN1,RAFN2,RAILOC,RANAME
34 N RARXAM,RASSN,RASTAT,RAXDT,X,Y
35 S A=$G(^RARPT(DA,0))
36 S Y=DA D RASET^RAUTL2 ; Derive case/exam data from file 70
37 S RADFN(0)=RADFN
38 S (RADFN,RANAME)=+$P(A,U,2)
39 S RANAME=$S($D(^DPT(RANAME,0)):$P(^(0),U),1:"Unknown")
40 S RASSN=$$SSN^RAUTL() S RADFN=RADFN(0)
41 S RACASE=$S($P(A,U)]"":$P(A,U),1:"Unknown")
42 S RAFN1=$P(A,U,3),RAFN2=$P($G(^DD(74,3,0)),U,2)
43 S RAXDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
44 S RAXDT=$S(RAXDT]"":RAXDT,1:"Unknown")
45 S RARXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),0))
46 S RAEXAM=$O(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P","B",+$G(RACN),0))
47 S RAEXAM(0)=$G(^RADPT(+$G(RADFN),"DT",+$G(RADTI),"P",+$G(RAEXAM),0))
48 S RAFN1=$P(RAEXAM(0),U,21),RAFN2=$P($G(^DD(70.03,21,0)),U,2)
49 S RADDT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
50 S RADDT=$S(RADDT]"":RADDT,1:"Unknown")
51 S RAFN1=$P(A,U,5),RAFN2=$P($G(^DD(74,5,0)),U,2)
52 S RASTAT=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
53 S RASTAT=$S(RASTAT]"":RASTAT,1:"Unknown")
54 S RAFN1=$P(RARXAM(0),U,4),RAFN2=$P($G(^DD(70.02,4,0)),U,2)
55 S RAILOC=$$XTERNAL^RAUTL5(RAFN1,RAFN2)
56 S RAILOC=$S(RAILOC]"":RAILOC,1:"Unknown")
57 S XMB(1)=RANAME,XMB(2)=RASSN,XMB(3)=RACASE
58 S XMB(4)=RAXDT,XMB(5)=RADDT,XMB(6)=RASTAT
59 S XMB(7)=RAILOC,XMB="RAD/NUC MED REPORT DELETION"
60 D ^XMB:$D(^XMB(3.6,"B",XMB))
61 K XMB,XMB0,XMC0,XMDT,XMM,XMMG
62 Q
Note: See TracBrowser for help on using the repository browser.