source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL21.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1RAUTL21 ;HOIFO/SWM,CRT;list & delete unneeded ^RARPT("ASTF" & "ARES" ;2/12/99 16:01
2 ;;5.0;Radiology/Nuclear Medicine;**26,45**;Mar 16, 1998
3 ;
4EN1 N RA1,RA2,RACNT,RAKILREF,RALL,RATOT
5 S U="^"
6 S $P(RADL,"=",32)=""
7 S $P(RASL,"-",26)=""
8 S RATOT=0 ; total # of superfluous x-refs
9 S RAKILREF=0 ; flag to control kill of x-refs and display
10 ;
11 D EN^DDIOL("RAD/NUC MED UTILITY TO LIST/DELETE LEFT-OVER REPORT X-REFS",,"!?3")
12 D EN^DDIOL(" ",,"!!")
13 ;
14 S DIR(0)="Y"
15 S DIR("B")="YES"
16 S DIR("A")=" Do you want to print a list of left-over x-refs?"
17 D ^DIR K DIR
18 I $D(DTOUT)!$D(DUOUT) Q
19 I Y=1 D
20 .N %ZIS
21 .S %ZIS("A")="Select Device: "
22 .D ^%ZIS I POP K STOUT,DUOUT,POP Q
23 .U IO
24 .F RAXREF="ARES","ASTF" D L1
25 .S:RATOT=0 RATOT=-1
26 .D ^%ZISC,HOME^%ZIS
27 ;
28 Q:RATOT<0
29 D EN^DDIOL(" ",,"!!")
30 S DIR(0)="Y"
31 S DIR("A")=" Do you want to clean up the"_$S(RATOT:"se "_RATOT,1:"")_" left-over x-refs?"
32 S DIR("B")="NO"
33 D ^DIR K DIR
34 I $D(DTOUT)!$D(DUOUT) Q
35 I Y=1 D
36 .S RAKILREF=1
37 .F RAXREF="ARES","ASTF" D L1
38 Q
39 ;
40L1 ; Loop through left-over x-refs
41 ;
42 N WAIT
43 ;
44 I 'RAKILREF D HEAD
45 ;
46 S WAIT=""
47 S RA1=0 F S RA1=$O(^RARPT(RAXREF,RA1)) Q:'RA1 D Q:WAIT="^"
48 . S RACNT=0
49 . S RA2=0 F S RA2=$O(^RARPT(RAXREF,RA1,RA2)) Q:'RA2 D Q:WAIT="^"
50 .. I $D(^RARPT(RA2,0)),$P(^RARPT(RA2,0),U,5)'="V" Q
51 .. S RACNT=RACNT+1 ; Total for this physician
52 .. S RATOT=RATOT+1
53 .. I 'RAKILREF D Q:WAIT="^"
54 ... I $Y>(IOSL-3) D WAIT Q:WAIT="^" S WAIT="" W @IOF D HEAD S RACNT=1
55 ... D EN^DDIOL($S(RACNT=1:$E($P($G(^VA(200,RA1,0)),U),1,30),1:" "),,"!?3")
56 ... D EN^DDIOL($S($D(^RARPT(RA2,0)):$P(^(0),U),1:"Unknown report #"_RA2),,"?40")
57 .. I RAKILREF D
58 ... D EN^DDIOL("^RARPT("""_RAXREF_""","_RA1_","_RA2_") deleted","","!?3")
59 ... K ^RARPT(RAXREF,RA1,RA2)
60 Q:WAIT="^"
61 I RATOT=0 D EN^DDIOL("< There are no left-over """_RAXREF_""" x-refs found. >","","!?10")
62 Q
63 ;
64HEAD ;
65 D EN^DDIOL("LEFT-OVER ^RARPT("""_RAXREF_""") X-REFS",,"!!?20")
66 D EN^DDIOL(RADL,,"!?20")
67 D EN^DDIOL($S(RAXREF="ARES":"RESIDENT",1:"STAFF")_" PHYSICIAN",,"!!?3")
68 D EN^DDIOL("CASE # OF LEFT-OVER X-REF",,"?40")
69 D EN^DDIOL($S(RAXREF="ARES":$E(RASL,1,18),1:$E(RASL,1,15)),,"!?3")
70 D EN^DDIOL(RASL,,"?40")
71 D EN^DDIOL(" ",,"!")
72 Q
73 ;
74WAIT ;
75 I $E(IOST,1,2)'="C-" S WAIT="" Q ;Don't prompt if report not to screen
76 ;
77 N DIR
78 S DIR(0)="E"
79 S (DIR("?"),DIR("??"))=""
80 D ^DIR K DIR
81 I Y=""!(Y=0) S WAIT="^"
82 Q
83 ;
84CHGPRC(RAOPRC,RANPRC,DA) ;If a procedure is changed during
85 ;exam edits, ensure that CM associations of the "changed to"
86 ;procedure are associated with the exam. If the "changed to"
87 ;procedure does not have CM associations, make sure the exam
88 ;does not have CM associations from the "changed from" procedure.
89 ;
90 ;called from the RA STATUS CHANGE & RA EXAM EDIT input templates
91 ;Input: RAOPRC=the IEN of the "changed from" procedure
92 ; RANPRC=the IEN of the "changed to" procedure
93 ; DA(2)=the IEN of the patient in the PATIENT (#2) file (RADFN)
94 ; DA(1)=the inverse date/time of the exam (RADTI)
95 ; DA=the IEN of case (RACNI)
96 ;
97 I +$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"CM",0)) D
98 .W !!?3,"Deleting the contrast media with this exam for procedure:",!?3,"'"_$P($G(^RAMIS(71,RAOPRC,0)),U)_"'."
99 .K ^RADPT(DA(2),"DT",DA(1),"P",DA,"CM") ;kills both data and 'B' xref
100 .D UPXCM^RAMAINU(.DA,"N") ;set CONTRAST MEDIA USED field to 'no'
101 .Q
102 I +$O(^RAMIS(71,RANPRC,"CM",0)) D
103 .W !!?3,"Adding the contrast media to this exam for procedure:",!?3,"'"_$P($G(^RAMIS(71,RANPRC,0)),U)_"'."
104 .D STUFCM70^RAMAINU(.DA,RANPRC)
105 .D UPXCM^RAMAINU(.DA,"Y") ;set CONTRAST MEDIA USED field to 'yes'
106 .Q
107 Q
Note: See TracBrowser for help on using the repository browser.