source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDTR05.m@ 1240

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

initial load of WorldVistAEHR
File size: 7.0 KB
Line 
1MAGDTR05 ;WOIFO/PMK - Read a DICOM image file ; 14 Nov 2006 6:24 AM
2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
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 ;; | 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 ;;
18LOOKUP(OUT,SITENUMB,ISPECIDX,IPROCS,STARTING,DUZREAD,DUZREAD2,LOCKTIME,STATLIST) ; RPC = MAG DICOM CON UNREADLIST GET
19 ; entry point to lookup entries in file
20 ;
21 ; OUT ------- Return array
22 ; SITENUMB -- Acquisition Site Number
23 ; ISPECIDX -- Index to Specialties (2005.84)
24 ; IPROCS ---- Indexes to Procedures (2005.85) - this is a comma-delimited list
25 ; STARTING -- Fileman date/time to begin sequential search
26 ; DUZREAD --- User's DUZ at the Reading Site
27 ; DUZREAD2 -- DIC(4) pointer to Reading Site
28 ; LOCKTIME -- timeout value for LOCKTIME
29 ; STATLIST -- status of entry (C, L, R, U, or W, in any combination)
30 ;
31 N ACQSITE ;- site index in Unread List
32 N ISTATUS ;-- counter to the status in STATLIST
33 N IPROC ;---- counter to IPROCS
34 N IPROCIDX ;- index to procedures (2005.85)
35 N TIMESTMP ;- last activity date/time for the entry
36 N SITENAME ;- name of acquisition site
37 N STATUS1 ;-- one status out of the STATLIST
38 N UNREAD ;--- pointer to entry in unread list
39 ;
40 S DUZREAD=$G(DUZREAD,0),DUZREAD2=$G(DUZREAD2,0),LOCKTIME=$G(LOCKTIME,0)
41 S STATLIST=$$UP^MAGDFCNV($G(STATLIST))
42 I STATLIST="" S STATLIST="CDLRUW" ; default to all STATUS values
43 ;
44 S ACQSITE=$$ACQSITE^MAGDTR06(SITENUMB)
45 I ACQSITE<0 S OUT="-1, ACQUISITION SITE #"_SITENUMB_" IS NOT DEFINED IN FILE 4" Q
46 S SITENAME=$P(ACQSITE,"^",2),ACQSITE=$P(ACQSITE,"^",1)
47 ;
48 I LOCKTIME,DUZREAD2 D UNLOCKER ; automatically unlock timed out studies
49 ;
50 K OUT
51 I STARTING=0 D ; loop through the STATUS index because it is faster
52 . S STATLIST=$TR(STATLIST,"D") ; remove the DELETED status from STATLIST
53 . F ISTATUS=1:1:$L(STATLIST) S STATUS1=$E(STATLIST,ISTATUS) D
54 . . F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D
55 . . . S UNREAD=""
56 . . . F S UNREAD=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS1,UNREAD)) Q:UNREAD="" D
57 . . . . D LOOKUP1(UNREAD)
58 . . . . Q
59 . . . Q
60 . . Q
61 . Q
62 E D ; retrieve just the latest events
63 . F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D
64 . . S TIMESTMP=STARTING ; reinitialize the starting date & time for each index to procedures
65 . . F S TIMESTMP=$O(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP)) Q:TIMESTMP="" D
66 . . . S UNREAD=""
67 . . . F S UNREAD=$O(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP,UNREAD)) Q:UNREAD="" D
68 . . . . D LOOKUP1(UNREAD)
69 . . . . Q
70 . . . Q
71 . . Q
72 . Q
73 Q
74 ;
75LOOKUP1(UNREAD) ; retrieve one entry from the unread list
76 N GMRCIEN
77 N DFN
78 N VADM
79 N ICN
80 N IFCSITE,IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME
81 N LISTDATA ;- read/unread list data
82 N QUIT
83 N READER
84 N SHORTID
85 N STATUS
86 N VA,VADM,VAERR
87 N VIPSTS ; VIP status
88 N I,LAST,X,Z
89 ;
90 S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
91 S STATUS=$P(LISTDATA,"^",11) ; status
92 Q:STATLIST'[STATUS ; skip the entry if it is not the right STATUS
93 ;
94 S GMRCIEN=$P(LISTDATA,"^",1)
95 S IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I") ; Routing Facility
96 ;
97 ; check if this consult can it be displayed to the reader
98 S QUIT=0
99 I DUZREAD D Q:QUIT
100 . I IFCSITE D Q:QUIT ; IFC reading site
101 . . I IFCSITE'=DUZREAD2 S QUIT=1
102 . . Q
103 . I STATUS="W" S QUIT=2 Q
104 . I STATUS="L" D Q:QUIT
105 . . S READER=$P(LISTDATA,"^",15) ; reader
106 . . I READER,READER'=DUZREAD S QUIT=3
107 . . Q
108 . Q
109 ;
110 ; acquisition site identification
111 S Z=UNREAD_"|"_GMRCIEN_"|"_SITENUMB_"|"_SITENAME
112 ; patient information
113 S DFN=$$GET1^DIQ(123,GMRCIEN,.02,"I")
114 D DEM^VADPT,PTSEC^DGSEC4(.VIPSTS,DFN)
115 S ICN=$$GETICN^MPIF001(DFN)
116 S X=$P(VADM(2),"^",1),SHORTID=$E(VADM(1),1)_$E(X,$L(X)-3,$L(X))
117 S Z=Z_"|"_VADM(1)_"|"_$P(VADM(2),"^",2)_"|"_ICN_"|"_SHORTID
118 S Z=Z_"|"_VIPSTS(1) ; VIP status
119 S Z=Z_"|"_$P(^MAG(2005.84,ISPECIDX,0),"^",1)_"|"_$P(^MAG(2005.84,ISPECIDX,2),"^",1)
120 S Z=Z_"|"_$P(^MAG(2005.85,IPROCIDX,0),"^",1)_"|"_$P(^MAG(2005.85,IPROCIDX,2),"^",1)
121 ; time stamps and image acquisition statistics
122 S Z=Z_"|"_$P(LISTDATA,"^",7) ; time of first image
123 S Z=Z_"|"_$P(LISTDATA,"^",8) ; time of last image
124 S Z=Z_"|"_$P(LISTDATA,"^",9) ; time of last activity
125 S Z=Z_"|"_(+$P(LISTDATA,"^",10)) ; #images
126 S Z=Z_"|"_STATUS
127 S Z=Z_"|"_$$GET1^DIQ(123,GMRCIEN,13,"I") ; consult/procedure flag
128 S Z=Z_"|"_$P($$GET1^DIQ(123,GMRCIEN,5)," - ",2) ; GMRC urgency
129 ;
130 ; get inter-facility consult data
131 S IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I") ; Routing Facility
132 I IFCSITE D ; inter-facility consult
133 . S IFCIEN=$$GET1^DIQ(123,GMRCIEN,.06,"I") ; remote consult file entry
134 . ; get IFC site abbreviation
135 . S I=$O(^MAG(2006.19,"D",IFCSITE,""))
136 . S IFCSITEA=$S(I:$P($G(^MAG(2006.19,I,0)),"^",4),1:"?")
137 . S IFCLTIME=$P(LISTDATA,"^",5),IFCRTIME=$P(LISTDATA,"^",6)
138 . I IFCLTIME,IFCRTIME S IFCETIME=$$FMDIFF^XLFDT(IFCRTIME,IFCLTIME,2)
139 . E S IFCETIME=""
140 . Q
141 E D ; local consult
142 . S (IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME)=""
143 . Q
144 S Z=Z_"|"_IFCSITE_"|"_IFCSITEA_"|"_IFCIEN
145 S Z=Z_"|"_IFCLTIME_"|"_IFCRTIME_"|"_IFCETIME
146 F I=12:1:16 S Z=Z_"|"_$P(LISTDATA,"^",I) ; reader identification
147 S Z=Z_"|"_$P(LISTDATA,"^",17) ; start of reading
148 S Z=Z_"|"_$P(LISTDATA,"^",18) ; end of reading
149 S LAST=$G(OUT(1),1) ; first element in the array is the counter
150 S LAST=LAST+1,OUT(LAST)=Z,OUT(1)=LAST
151 Q
152 ;
153UNLOCKER ; automatically unlock any timed out studies
154 N GMRCIEN
155 N IFCSITE
156 N SECONDS ;-- date/time in seconds
157 N STATUS
158 N UNLOCKTM ;- earliest date/time for a lock (FM format)
159 N UNREAD ;--- pointer to entry in unread list
160 N %,%H,X
161 ;
162 ; calculate the earliest automatic unlock date/time
163 S SECONDS=86400*$H+$P($H,",",2)-(60*LOCKTIME)
164 S %H=(SECONDS\86400)_","_(SECONDS#86400)
165 D YMD^%DTC S UNLOCKTM=X_% ; convert to FM format
166 ;
167 ; traverse the "lock list" and unlock those that have timed out
168 F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D
169 . S UNREAD=""
170 . F S UNREAD=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"L",UNREAD)) Q:UNREAD="" D
171 . . S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
172 . . ; check for a lock timeout
173 . . I $P(LISTDATA,"^",17)<UNLOCKTM D ; lock timeout
174 . . . ; only unlock studies that are to be done at the reading site
175 . . . I DUZREAD2=$P(LISTDATA,"^",16) D UNLOCK^MAGDTR04(UNREAD,.STATUS)
176 . . . Q
177 . . Q
178 . Q
179 Q
Note: See TracBrowser for help on using the repository browser.