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