source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAEDCN.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: 7.5 KB
Line 
1RAEDCN ;HISC/CAH,FPT,GJC,SS AISC/MJK,RMO-Edit Exams by Case Number ;1/11/02 11:15
2 ;;5.0;Radiology/Nuclear Medicine;**5,13,10,18,28,31,34,45,85**;Mar 16, 1998;Build 4
3 ;
4 ; 06/11/2007 KAM/BAY RA*5*85 Remedy Call 174790 Change Exam Cancel
5 ; to allow only descendent exams with stub report
6 ;
7 ;last modified by SS JUNE 21,2000 for P18
8START D SET^RAPSET1 I $D(XQUIT) K XQUIT,RAFLG,RADR,POP,RAQUICK Q
9START1 D ^RACNLU G Q:X="^"
10 I RADR="[RA DIAGNOSTIC BY CASE]" N RAPRTSET,RAMEMARR,RA3 D EN2^RAUTL20(.RAMEMARR) S RA3=99 I RAPRTSET W ! D WHYMSG2^RASTED G Q ;skip edit because member of set =2
11 I $D(^RA(72,"AA",RAIMGTY,9,+RAST)),'$D(^XUSEC("RA MGR",+$G(DUZ))) W !!?3,$C(7),"You do not have the appropriate access privileges to edit completed exams." G START1
12 I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !!?3,$C(7),"Exam has been 'cancelled' therefore it cannot be edited." G START1
13 I RADR="[RA DIAGNOSTIC BY CASE]",$D(^RARPT(RARPT,0)),$P(^(0),"^",5)="V" W !!?3,$C(7),"A report has been verified for this exam, therefore it cannot be edited.",! G START
14 S DA=RADFN,DIE("NO^")="OUTOK",DIE="^RADPT(",DR=RADR
15 I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D G:+$G(RAXIT) START1
16 . S RADADA=RADTI,RADIE="^RADPT("_RADFN_",""DT"","
17 . S RAXIT=$$LOCK^RAUTL12(RADIE,RADADA)
18 . Q
19 I RADR="[RA EXAM EDIT]" D
20 . N RADISPLY
21 . S RADISPLY=$G(^RAMIS(71,+$P($G(^RADPT(+RADFN,"DT",+RADTI,"P",+RACNI,0)),U,2),0)) ; set $ZR to 71 for prccpt^radd1, not call raprod since diff col
22 . S RADISPLY=$$PRCCPT^RADD1()
23 . W !,?24,RADISPLY
24 .;
25 .;save 'before' CM data value to compare against the possible 'after'
26 .;value
27 .D TRK70CMB^RAMAINU(RADFN,RADTI,RACNI,.RATRKCMB) ;RA*5*45
28 .;
29 . Q
30 D:RADR'="[RA NO PURGE SPECIFICATION]" SVBEFOR^RAO7XX(RADFN,RADTI,RACNI) ;P18 save before edit to compare it in RAUTL1 later
31 D ^DIE K DIE("NO^"),DE,DQ,DIE,DR,RAZCM
32 D:RADR'="[RA NO PURGE SPECIFICATION]" UP1^RAUTL1
33 ;
34 ;1) check data consistency between 'CONTRAST MEDIA USED' & 'CONTRAST
35 ;MEDIA'
36 ;2) check 'before' CM data against 'after' CM data, file in audit log
37 ;if necessary. Remember, contrast media asked when in input template:
38 ;RA EXAM EDIT (RA*5*45)
39 I RADR="[RA EXAM EDIT]" D
40 .S RACMDA=RACNI,RACMDA(1)=RADTI,RACMDA(2)=RADFN
41 .D XCMINTEG^RAMAINU1(.RACMDA) ;1
42 .D TRK70CMA^RAMAINU(RADFN,RADTI,RACNI,RATRKCMB) ;2
43 .K RACMDA Q
44 ;
45 I $D(RAFLG("EDIT"))!($D(RAFLG("DIAG"))) D UNLOCK^RAUTL12(RADIE,RADADA)
46 K RATRKCMB,RADUZ,RAZZ W ! G START1:'+$G(RAXIT)
47 ;
48Q K %,%DT,%W,%X,%Y,%Y1,A,C,D0,D1,D2,DA,DIC,DIE,DIV,DK,I,ORIFN,ORVP,POP,RACN,RACNI,RACS,RACT,RADADA,RADATE,RADFN,RADIE,RADIV,RADR,RADTE,RADTI,RAEXFM,RAEXLBLS,RAFIN,RAFL,RAFLG,RAFLH,RAFLHFL,RAHEAD,RAI,RAJ
49 K RAMES,RANME,RANUM,RAOIFN,RAOR,RAORDIFN,RAOREA,RAORIFN,RAOSEL,RAOSTS,RAPOP,RAPRI,RAPRC,RAQUICK,RAPRIT,RARPT,RARPTZ,RASN,RASSN,RAST,RASTI,RAVW,X,XQUIT,VAINDT,VADMVT,Y,^TMP($J,"RAEX")
50 K %H,%I,D,D3,DDER,DI,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,GMRAL
51 K J,SDCLST,R1,RA,RACANC,RACN0,RACPT,RACPTNDE,RADA,RAEND,RAFELIG,RAFST
52 K RAIX,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RAXIT,VA,VADM,VAERR,Z
53 K DFN,DIPGM,DISYS,DQ,DR,HLN,HLRESLT,HLSAN,RAAFTER,RABEFORE,X0
54 K DLAYGO,DDH,RADFLTP
55 Q
56 ;
57DIAG N RADIAG,RAXIT
58 S RAXIT=0,RAFLG("DIAG")="",RADR="[RA DIAGNOSTIC BY CASE]" G START
59 ;
60SAVE S RADR="[RA NO PURGE SPECIFICATION]" G START
61 ;
62EDIT ; Case No. Exam Edit
63 N RAEDIT,RAXIT
64 N RAREM,RANUZD1,RAPSDRUG,RA00,RADIOPH,RALOW,RAHI,RADRAWN,RAASK,RADOSE,RASKMEDS,RAWHICH ;these are used by the edit template
65 S RAXIT=0,RAFLG("EDIT")="",RAQUICK=1,RADR="[RA EXAM EDIT]" G START
66 ;
67CANCEL D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
68 S RAXIT=$$CKREASON^RAEDCN1("C") I RAXIT K RAXIT Q ;P18
69 D ^RACNLU G Q:X="^" I $D(^RA(72,"AA",RAIMGTY,0,+RAST)) W !?3,$C(7),"This exam has already been cancelled!" G Q
70 I $D(^RA(72,+RAST,0)),$P(^(0),"^",6)'="y" W !?3,$C(7),"This exam is in the '",$P(^(0),"^"),"' status and cannot be 'CANCELLED'." G Q
71 ; 06/11/2007 KAM/BAY *85 Added descendent check to next line
72ASKIMG I RARPT,($$STUB^RAEDCN1(RARPT)),($$PSET^RAEDCN1(RADFN,RADTI,RACNI)) D G:"Nn"[$E(X) Q G:"Yy"[$E(X) ASKCAN W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel a descendent exam with images, or 'NO' not to." G ASKIMG
73 . S X=RANME_"'s Case No. "_$E(RADTE,4,7)_$E(RADTE,1,2)_"-"_RACN
74 . W !!?10,"----------------------------------",$C(7)
75 . W !?10,X
76 . W !?10,"This descendent exam has associated images.",$C(7)
77 . W !?10,"----------------------------------",$C(7)
78 . I '$D(^XUSEC("RA MGR",DUZ)) D S X="N" Q
79 .. W !!?3,"** You do not have the RA MGR key to cancel an exam with images. **",$C(7)
80 .. R !!?10,"Press RETURN to continue.",X:DTIME
81 .. Q
82 . R !!,"Do you really want to cancel this exam with images? NO//",X:DTIME S:'$T!(X="")!(X["^") X="N"
83 . Q
84 I RARPT W !?3,$C(7),"A report has been filed for this case. Therefore cancellation is not allowed!" G Q
85ASKCAN R !!,"Do you wish to cancel this exam now? NO// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" $C(7) W !!?3,"Enter 'YES' to cancel this exam, or 'NO' not to." G ASKCAN
86 N REM ;used for remarks within edit template
87 L +^RADPT(RADFN):1 I '$T W !,$C(7),"Someone else is editing the patient you selected",!,"Please try later" K RADTE,RACN,RAPOP,RADUZ G Q
88 S DA=RADFN,DR="[RA CANCEL]",DIE="^RADPT(" D ^DIE K DE,DQ,DIE,DR
89 K RADTE,RACN,RAPOP,RADUZ ;moved from edit template
90PACS I '$D(Y),$D(RAFIN) W !?10,"...cancellation complete." D DELPNT^RAUTL20(RADFN,RADTI,RACNI),^RAORDC,CANCEL^RAHLRPC
91 L -^RADPT(RADFN)
92 G Q
93 ;
94DUP ; Option: RA FLASH
95 N RAREGX,RAYN D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
96DUP1 D ^RACNLU G Q:X="^"
97 G Q:'$D(^RADPT(RADFN,"DT",RADTI,0))
98 S RAREGX(0)=$G(^RADPT(RADFN,"DT",RADTI,0))
99 S RAREGX(4)=+$P(RAREGX(0),"^",4)
100 I +$G(RAMLC)'=RAREGX(4) D I $P(RAYN,"^",2) D Q QUIT
101 . W !!?3,"Your sign-on location is: "
102 . W $P($G(^SC(+$G(^RA(79.1,+$G(RAMLC),0)),0)),"^")_". The location"
103 . W !?3,"of case ",RACN," is "
104 . W $P($G(^SC(+$G(^RA(79.1,RAREGX(4),0)),0)),"^"),".",!
105 . K DIR,DIROUT,DIRUT,DTOUT,DUOUT S DIR(0)="Y",DIR("B")="Yes"
106 . S DIR("?")="Enter 'Y'es to switch locations or 'N'o exit the option."
107 . S DIR("A")="Do you wish to switch Imaging Locations" D ^DIR
108 . S RAYN=+Y_"^"_$S($D(DIRUT):1,1:0)
109 . K DIR,DIROUT,DIRUT,DTOUT,DUOUT Q:'+RAYN ; quit if no
110 . D KILL^RAPSET1,SET^RAPSET1 ; else switch locations
111 . I $D(XQUIT) S $P(RAYN,"^",2)=1 K XQUIT
112 . Q
113 S ION=$P(RAMLC,"^",3) ; imaging location flash card printer (if any)
114 G Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S Y=^(0),Y=$S($D(^RAMIS(71,+$P(Y,"^",2),0)):$P(^(0),"^",3),1:"")
115 ; if Y, then convert the pointer value 'Y' to the .01 value of
116 ; the procedure flash card printer (if any)
117 I Y]"",$D(^%ZIS(1,+Y,0)) D
118 . S Y(0)=$$GET1^DIQ(3.5,+Y,.01) ; .01 value for proc flash card printer
119 . S:Y(0)'=$P(RAMLC,"^",3) ION=Y(0) K Y(0)
120 . ; if flash card printer for the imaging location differs from
121 . ; the procedure flash card printer, default (print to) to the flash
122 . ; card printer for the procedure.
123 . Q
124 S RAMES="W !!,""Duplicates queued to print on "",ION,"".""",RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1),RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1),RAFLHFL=RACNI
125FLH ; Flash Cards
126 R !,"How many flash cards? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RANUM=X I '(RANUM?.N)!(RANUM>20) W !?3,$C(7),"Must be a whole number less than 21!" G FLH
127EXM ; Exam Labels
128 R !,"How many exam labels? 1// ",X:DTIME G DUP1:'$T!(X["^") S:X="" X=1 S RAEXLBLS=X I '(RAEXLBLS?.N)!(RAEXLBLS>20) W !?3,$C(7),"Must be a whole number less than 21!" G EXM
129 S IOP="Q" S:ION]"" RADFLTP=ION
130 K RAFL D Q^RAFLH,Q G DUP1
131 ;
132SETVARS ; Setup key Rad/Nuc Med variables
133 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
134 Q:'($D(RACCESS(DUZ))\10) ; user does not have location access
135 I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT
136 Q
Note: See TracBrowser for help on using the repository browser.