source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJUPD1.m@ 701

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

revised back to 6/30/08 version

File size: 8.4 KB
RevLine 
[623]1MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003 10:02 AM
2 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19 ; Subroutines for RPC's to update Exam Status to "Interpreted", and
20 ; for "Closing" a case that is open on the DX Workstation
21 ;
22ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR
23 D @^%ZOSF("ERRTN")
24 Q:$Q 1 Q
25 ;
26STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE
27 ; Update Exam Status to "Interpreted" and/or Close the exam
28 ; Only updates the Status if the current value is "Examined"
29 ; This routine defines variables needed for calling the Radiology
30 ; package routine UP1^RAUTL1, for filing Status updates
31 ;
32 ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY
33 ; UPDFLAG = 1/0 -- 1 to perform update; else no update made
34 ; RARPT = ptr to Rad Exam Report file
35 ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam
36 ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data
37 ; MAGGRY = return results in @MAGGRY
38 ;
39 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
40 N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET
41 N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP
42 N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST
43 S MAGLST="MAGJUPDATE"
44 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
45 S DIQUIET=1 D DT^DICRW
46 D NOW^%DTC S TIMESTMP=%
47 S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6)
48 S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update"
49 S RAPRTSET=0
50 I RADFN,RADTI,RACNI
51 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ
52 D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
53 I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ
54 ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA,
55 ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM
56 ;11 RAST DAYCASE RAELOC RASTP RASTORD
57 ;16 RADTPRT
58 S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
59 S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",2),RADTE=$P(RADATA,U,7)
60 S RAINT=RADTI_"-"_RACNI
61 D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case
62 ; proceed only if case was locked by this user
63 ; if it was not Locked, then do NOT update PS, Key Images
64 I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ
65 I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ
66 S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist
67 ; now we know this user had locked the case, & wants to do Status update
68 D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet
69 ;
70 ; IF exam is not "Examined", and not "Cancelled" and past "Waiting"
71 ; then assume it has already been updated via another pathway,
72 ; either as printset member (via code at tag PRTSET, below),
73 ; or from a voice-dictation or terminal session by the radiologist
74 ; For these cases, no warning msg is sent
75 ; Else, update not allowed, so give warning msg
76 ; Note that when the Exam was OPENed, it must have had status "Examined"
77 I '$D(^RA(72,"AVC","E",$P(RADATA,U,11))) D G STATUSX:(+$P(REPLY,U,2)=1),STATUSZ ; Current Status MUST be "Examined" Category
78 . I $P(RADATA,U,15)>2 D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista
79 .. S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx
80 .. I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated"
81 .. E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
82 . E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
83 ;
84 ; now ready to update exam status
85 S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
86 S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100")
87 ;
88 ; Update interpreting radiologist field in Rad file
89 I RIST D I RACNILST="" G STATUSZ
90 . N SAVRACNI,RTN S RACNILST=""
91PRTSET . ; if exam is part of Rad Print-Set, then update all exams of printset
92 . I RAPRTSET D
93 .. S ACNLST="",SAVRACNI=RACNI,X=0
94 .. F I=0:1 S X=$O(MAGPSET(X)) Q:'X S RACNILST=RACNILST_$S(I:U,1:"")_X S:RACNE'=+MAGPSET(X) ACNLST=ACNLST_", "_"-"_+MAGPSET(X)
95 . E S RACNILST=RACNI
96 . F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q
97 .. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
98 .. D STUFPHY^RARIC1(DUZ,RIST,.RTN)
99 .. I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST=""
100 . I RAPRTSET S RACNI=SAVRACNI
101 S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update
102 ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs
103 I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown")
104 I G STATUSZ
105 ;
106 S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN
107 ;
108STATUSX ; Newly Interpreted exam:
109 ; Log the Interpreted event
110 D LOG^MAGJUTL3("VR-INT",LOGDATA)
111 ; Update Recent Exams List
112 G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled
113 L +^XTMP("MAGJ2","RECENT"):5
114 E G STATUSZ
115 N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D
116 . S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI
117 L -^XTMP("MAGJ2","RECENT")
118STATUSZ ;
119 ; store PS, Key Image data
120 I UPDPSKEY,($D(DATA)>9) D
121 . D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X)
122 . S REPLY=REPLY_$P(X,"~",2,99)
123 S @MAGGRY@(0)=REPLY
124 K ^TMP($J,"MAGRAEX"),^("RAE1")
125 Q
126 ;
127CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case
128 ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG
129 ;
130 ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam
131 ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine
132 ; STATUS, above (which has already called GETEXAM)
133 ; RSL = return result of the Close
134 ; This subroutine may be called directly (to close a case without
135 ; doing a status update), or is called from tag STATUS, above, when
136 ; also doing a status update
137 ;
138 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
139 N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK
140 S DFN=$P(PARAMS,U),DTI=$P(PARAMS,U,2),CNI=$P(PARAMS,U,3),RPT=$P(PARAMS,U,4),UPDFLAG=$P(PARAMS,U,5)
141 S LOGDATA=""
142 I $P($G(^MAG(2006.69,1,0)),U,4)
143 E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled
144 S RIST=+MAGJOB("USER",1) I RIST
145 E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist
146 I DFN,DTI,CNI
147 E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ
148 ;
149 I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ
150 . D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET)
151 . I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken"
152 . E S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
153 S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12)
154 I RARPT,DAYCASE
155 E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ
156 ;
157 D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK)
158 S LOGDATA=$P(MYLOCK(1),"|",2)
159 I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ
160 . I UPDFLAG S REPLY="0^1~Case #"_DAYCASE_$S(X]"":" locked by "_X,1:" not locked by "_$P(MAGJOB("USER",1),U,2))_"--No Status update performed"
161 . E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do
162 ;
163 I UPDFLAG S REPLY=1_U_RIST
164 E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed."
165CLOSEZ S RSL=REPLY
166 Q
167 ;
168END Q ;
Note: See TracBrowser for help on using the repository browser.