source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL20.m

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

initial load of FOIAVistA 6/30/08 version

File size: 6.3 KB
Line 
1RAUTL20 ;HISC/SWM-Utility Routine ;6/16/97 14:27
2 ;;5.0;Radiology/Nuclear Medicine;**5,34**;Mar 16, 1998
3 ;
4EN1 ; for displaying + and . during case lookup
5 S RAPRTSET=0
6 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
7 Q:RADFN=""!(RADTI="")!(RACNI="")
8 ; output : RAPRTSET=1 : case is part of a combined PRINTset, & flag it
9 ; RAMEMLOW=1 : case is lowest ien of print set AND flag it
10 N RA1,RA2,RA3,RA4,RA5,RA6,RA7,RACN S RA1="",RA3="A",RA5=0
11 S RACN=+$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
12 S RAMEMLOW=0
13 S RAPRTSET=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2
14 Q:'RAPRTSET
15 ; put + infront of lowest ien of case that has MEMBER OF SET = 2
16 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P",RA1)) Q:RA1="" Q:$P($G(^(RA1,0)),U,25)=2 ; RA1 is at lowest ien with MEMBER OF SET = 2
17 S:RACNI=RA1 RAMEMLOW=1
18 S RA1="" F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RA1)) Q:RA1="" D LOOP1
19 I RA5 S RAPRTSET=0,RAMEMLOW=0 ;don't display if ptrs to #74 differ within set
20 Q
21LOOP1 ; RA1= : for-loop var
22 ; RA2= : (1) ien for 70.03 (2) also, pointer value to file #74
23 ; RA3= : holds earliest case with pointer value to file #74
24 ; RA4= : (ienof #70.03)=case number^procedure pointers^ptr #74
25 ; RA5=0 : all cases in set point to same non-null rarpt() or all null
26 ; regardless of cancelled status
27 ; RA5<>0: one or more cases in set point to different rarpt()
28 ; RA6= : pointer to file #72 examination status
29 ; RA7=1 : denote call of LOOP1 came from EN2 and not from EN1
30 S RA2=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RA1,0))
31 ; skip rec if it's not part of combined report
32 Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RA2,0),"^",25)'=2
33 S:$G(RA7) RA4=RA2,RA4(RA4)=RA1
34 S RA2=$P(^RADPT(RADFN,"DT",RADTI,"P",RA2,0),"^",17),RA6=$P(^(0),"^",3) S:$G(RA7) RA4(RA4)=RA4(RA4)_"^"_$P(^(0),"^",2)_"^"_$P(^(0),"^",17)_"^"_$P(^(0),"^",3)
35 ; skip if exm canc'd & exm's pc 17 is null
36 I $P($G(^RA(72,+RA6,0)),"^",3)=0,RA2="" Q
37 S:RA3="A" RA3=RA2
38 I RA5=0,RA2]"" S RA5=RA2-RA3
39 Q
40EN2(RA4) ; display all print members' procs during report editing/printg
41 S RAPRTSET=0
42 Q:'$D(RADFN)!('$D(RADTI))!('$D(RACNI))
43 Q:RADFN=""!(RADTI="")!(RACNI="")
44 ; output : RA4(IEN OF #70.03)=CASE NUMBER^IEN OF #71 (procedure)^ptr #74
45 ; ^exm stat
46 ; RAPRTSET = 1 : case is part of a combined PRINTset
47 N RA1,RA2,RA3,RA5,RA6,RA7 S RA1="",RA3="A",RA5=0,RA7=1
48 F S RA1=$O(RA4(RA1)) Q:RA1="" K RA4(RA1) ;clean up array
49 S RAPRTSET=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",25)=2
50 Q:'RAPRTSET
51 F S RA1=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RA1)) Q:RA1="" D LOOP1
52 I RA5 S RAPRTSET=0 ;don't display if ptrs to #74 differ within set
53 Q
54EN3(RA4) ; for print set, AFTER record is created in rarpt()
55 Q:'$D(RADFN)!('$D(RADTI))
56 Q:RADFN=""!(RADTI="")
57 ; output :RA4(IEN OF #70.03)=CASE NUMBER (ONLY THOSE CASES FROM #74.05)
58 N RA1,RA2,RA3,RA5 S RA1="",RA3="A"
59 F S RA1=$O(RA4(RA1)) Q:RA1="" K RA4(RA1) ;clean up array
60 S RA5=$S($G(RARPT):RARPT,$G(RAIEN):RAIEN,1:0) Q:RA5=0
61 F S RA1=$O(^RARPT(RA5,1,"B",RA1)) Q:RA1="" S RA2=$P(RA1,"-",2),RA3=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RA2,0)),RA4(RA3)=RA2
62 Q
63XPRI ;loop thru sub-file #74.05 to set/kill prim. xref for other prt members
64 Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RARAD))!('$D(RAXREF))!('$D(DA))
65 Q:$O(^RARPT(DA,1,"B",0))=""
66 N RA1,RA200 S RA1=""
67XPRI1 S RA1=$O(^RARPT(DA,1,"B",RA1)) Q:RA1=""
68 S RACNIZ=$O(^RADPT(RADFNZ,"DT",RADTIZ,"P","B",$P(RA1,"-",2),0))
69 G:'$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,0)) XPRI1 S RA200=+$P(^(0),"^",RARADOLD) ; use raradold to get piece number in "p" node
70 G XPRI1:'RA200
71 S:$D(RASET) ^RARPT(RAXREF,RA200,DA)=""
72 K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)
73 G XPRI1
74XSEC ;loop thru sub-file #74.05 to set/kill sec. xref for other print members
75 Q:'$D(RADFNZ)!('$D(RADTIZ))!('$D(RASECOND))!('$D(RAXREF))!('$D(DA))
76 Q:$O(^RARPT(DA,1,"B",0))=""
77 N RA1,RA2,RA200 S RA1=""
78XSEC1 S RA1=$O(^RARPT(DA,1,"B",RA1)) Q:RA1=""
79 S RACNIZ=$O(^RADPT(RADFNZ,"DT",RADTIZ,"P","B",$P(RA1,"-",2),0))
80 G:'$D(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,0)) XSEC1 G:'$D(^(RASECOND,0)) XSEC1
81 S RA2=0
82XSEC2 S RA2=$O(^RADPT(RADFNZ,"DT",RADTIZ,"P",RACNIZ,RASECOND,RA2)) G:'+RA2 XSEC1 S RA200=+$G(^(RA2,0))
83 G:'RA200 XSEC2
84 S:$D(RASET) ^RARPT(RAXREF,RA200,DA)=""
85 K:$D(RAKILL) ^RARPT(RAXREF,RA200,DA)
86 G XSEC2
87FLAGMEM() ;in distr list, print + if case is part of a print set
88 ; called from File #74's print templates
89 N RA1 S RA1=""
90 I '$D(D0) Q RA1
91 S RA1=$P($G(^RABTCH(74.4,D0,0)),U) I RA1="" Q RA1
92 S RA1=$O(^RARPT(RA1,1,"B",0)) S:RA1]"" RA1="+"
93 Q RA1
94DELPNT(RADFN,RADTI,RACNI) ; When an exam is cancelled & it is associated
95 ; with data in the Nuc Med Exam Data file (70.2) ask the user if this
96 ; pointer to 70.2 is to be deleted. Also delete the flag which
97 ; indicates that the dosage ticket had printed for this exam.
98 ; Called from CANCEL^RAEDCN
99 ; Input: RADFN - Internal Entry Number (IEN) of the Patient.
100 ; RADTI - Date/Time of the examination (inverse format)
101 ; RACNI - IEN of the exam for this date/time
102 ;
103 ;- Delete entry in 'Dosage Ticket Printed?' field DD: 70.03, field: 29 -
104 N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",29)="@"
105 D FILE^DIE("","RAFDA")
106 ;----------------------------------------------------------------------
107 Q:'+$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",28) ;no NucMed Xam data
108 K RAFDA N RAYN
109 F D Q:RAYN]""
110 . R !!?3,"Do you wish to delete the radiopharmaceutical data associated",!?3,"with this exam? No//",RAYN:DTIME
111 . I RAYN["^"!('$T) S RAYN="^" Q ;don't delete pntr if '^' or timeout
112 . S RAYN=$E(RAYN) S:RAYN="" RAYN="N"
113 . S RAYN=$$UP^XLFSTR(RAYN) Q:RAYN="N" ;exit, don't del 70.2 pnt
114 . I RAYN="Y" D Q ; delete the pointer to 70.2, then quit
115 .. N RAFDA S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",500)="@"
116 .. D FILE^DIE("","RAFDA")
117 .. ; NOTE: This silent FileMan call not only deletes the pointer to
118 .. ; the entry in the Nuc Med Exam Data file (70.2), but the
119 .. ; entry in 70.2 itself. This is because a M X-Ref exists on
120 .. ; the field which points to file 70.2 that also deletes the
121 .. ; entry in the Nuc Med Exam Data file. Please refer to
122 .. ; ^DD(70.03,500,.. for more information.
123 .. Q
124 . W !!?3,"Enter 'Yes' to delete the radiopharmaceutical data associated with this exam.",!?3,"Enter 'No' to preserve the radiopharmaceutical data associated with this",!?3,"exam. "
125 . W "Enter '^' to exit without deleting the radiopharmaceutical data",!?3,"associated with this exam.",$C(7)
126 . S RAYN=""
127 . Q
128 Q
Note: See TracBrowser for help on using the repository browser.