MAGDTR05.m

MAGDTR05 ;WOIFO/PMK,JSL,SAF,NST - Read a DICOM image file ; 18 Jan 2013 10:44 AM

 ;;3.0;IMAGING;**46,54,123,127**;Mar 19, 2002;Build 4231;Apr 01, 2013

 ;; Per VHA Directive 2004-038, this routine should not be modified.

 ;; +---------------------------------------------------------------+

 ;; | Property of the US Government.                                |

 ;; | No permission to copy or redistribute this software is given. |

 ;; | Use of unreleased versions of this software requires the user |

 ;; | to execute a written test agreement with the VistA Imaging    |

 ;; | Development Office of the Department of Veterans Affairs,     |

 ;; | telephone (301) 734-0100.                                     |

 ;; | The Food and Drug Administration classifies this software as  |

 ;; | a medical device.  As such, it may not be changed in any way. |

 ;; | Modifications to this software may result in an adulterated   |

 ;; | medical device under 21CFR820, the use of which is considered |

 ;; | to be a violation of US Federal Statutes.                     |

 ;; +---------------------------------------------------------------+

 ;;

LOOKUP(OUT,STATNUMB,ISPECIDX,IPROCS,STARTING,DUZREAD,DUZREAD2,LOCKTIME,STATLIST,DUZRDSTN) ; RPC = MAG DICOM CON UNREADLIST GET

 ; entry point to lookup entries in file

 ; 

 ; OUT ------- Return array

 ; STATNUMB -- Acquisition Station Number

 ; ISPECIDX -- Index to Specialties (2005.84)

 ; IPROCS ---- Indexes to Procedures (2005.85) - this is a comma-delimited list

 ; STARTING -- Fileman date/time to begin sequential search

 ; DUZREAD --- User's DUZ at the Reading Site

 ; DUZREAD2 -- DIC(4) pointer to Reading Site

 ; LOCKTIME -- timeout value for LOCKTIME

 ; STATLIST -- status of entry (C, L, R, U, or W, in any combination)

 ; DUZRDSTN -- Station Number to Reading Site

 ; 

 ; DUZRDSTN (Station Number, e.g. 660AA) and DUZREAD2 (IEN in INSTITUTION file (#4), e.g. 6001) describe same site

 ; Cannot switch to Station Number only. Old GUI client, before P127, sends DUZREAD2 (Site IEN) only

 N ACQSITE ;- site index in Unread List

 N ISTATUS ;-- counter to the status in STATLIST

 N IPROC ;---- counter to IPROCS

 N IPROCIDX ;- index to procedures (2005.85)

 N TIMESTMP ;- last activity date/time for the entry

 N SITENAME ;- name of acquisition site

 N STATUS1 ;-- one status out of the STATLIST

 N UNREAD ;--- pointer to entry in unread list

 ;

 S DUZREAD=$G(DUZREAD,0)

 S DUZREAD2=$$SITEIEN^MAGDTR05($G(DUZREAD2),$G(DUZRDSTN))  ; Resolve the Reading Site Station number

 S LOCKTIME=$G(LOCKTIME,0)

 S STATLIST=$$UP^MAGDFCNV($G(STATLIST))

 I STATLIST="" S STATLIST="CDLRUW" ; default to all STATUS values

 ;

 S ACQSITE=$$ACQSITE^MAGDTR06(STATNUMB)

 I ACQSITE<0  S OUT="-1, ACQUISITION STATION NUMBER "_STATNUMB_" IS NOT DEFINED IN FILE 4" Q

 S SITENAME=$P(ACQSITE,"^",2),ACQSITE=$P(ACQSITE,"^",1)

 ;

 I LOCKTIME,DUZREAD2 D UNLOCKER ; automatically unlock timed out studies

 ;

 K OUT

 I STARTING=0 D  ; loop through the STATUS index because it is faster

 . S STATLIST=$TR(STATLIST,"D") ; remove the DELETED status from STATLIST

 . F ISTATUS=1:1:$L(STATLIST) S STATUS1=$E(STATLIST,ISTATUS) D

 . . F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D

 . . . S UNREAD=""

 . . . F  S UNREAD=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS1,UNREAD)) Q:UNREAD=""  D

 . . . . D LOOKUP1(UNREAD)

 . . . . Q

 . . . Q

 . . Q

 . Q

 E  D  ; retrieve just the latest events

 . F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D

 . . S TIMESTMP=STARTING ; reinitialize the starting date & time for each index to procedures

 . . F  S TIMESTMP=$O(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP)) Q:TIMESTMP=""  D

 . . . S UNREAD=""

 . . . F  S UNREAD=$O(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP,UNREAD)) Q:UNREAD=""  D

 . . . . D LOOKUP1(UNREAD)

 . . . . Q

 . . . Q

 . . Q

 . Q

 Q

 ;

LOOKUP1(UNREAD) ; retrieve one entry from the unread list

 N GMRCIEN

 N DFN

 N VADM

 N ICN

 N IFCSITE,IFCSITSN,IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME

 N LISTDATA ;- read/unread list data

 N QUIT

 N READER

 N SHORTID

 N STATUS

 N VA,VADM,VAERR

 N VIPSTS ; VIP status

 N I,LAST,X,Z

 ;

 S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))

 S STATUS=$P(LISTDATA,"^",11) ; status

 Q:STATLIST'[STATUS  ; skip the entry if it is not the right STATUS

 ;

 S GMRCIEN=$P(LISTDATA,"^",1)

 S IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I") ; Routing Facility

 ;

 ; check if this consult can it be displayed to the reader

 S QUIT=0

 I DUZREAD D  Q:QUIT

 . I IFCSITE D  Q:QUIT  ; IFC reading site

 . . I IFCSITE'=DUZREAD2 S QUIT=1

 . . Q

 . I STATUS="W" S QUIT=2 Q

 . I STATUS="L" D  Q:QUIT

 . . S READER=$P(LISTDATA,"^",15) ; reader

 . . I READER,READER'=DUZREAD S QUIT=3

 . . Q

 . Q

 ;

 ; acquisition site identification

 S Z=UNREAD_"|"_GMRCIEN_"|"_STATNUMB_"|"_SITENAME

 ; patient information

 S DFN=$$GET1^DIQ(123,GMRCIEN,.02,"I")

 D DEM^VADPT ; Supported IA (#10061)

 D PTSEC^DGSEC4(.VIPSTS,DFN) ; IA #3027

 S ICN=$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI")  ; IA #2701

 S X=$TR(VA("PID"),"-",""),SHORTID=$E(VADM(1),1)_$E(X,$L(X)-3,$L(X)) ;P123

 S Z=Z_"|"_VADM(1)_"|"_VA("PID")_"|"_ICN_"|"_SHORTID ;P123

 S Z=Z_"|"_VIPSTS(1) ; VIP status

 S Z=Z_"|"_$P(^MAG(2005.84,ISPECIDX,0),"^",1)_"|"_$P(^MAG(2005.84,ISPECIDX,2),"^",1)

 S Z=Z_"|"_$P(^MAG(2005.85,IPROCIDX,0),"^",1)_"|"_$P(^MAG(2005.85,IPROCIDX,2),"^",1)

 ; time stamps and image acquisition statistics

 S Z=Z_"|"_$P(LISTDATA,"^",7) ; time of first image

 S Z=Z_"|"_$P(LISTDATA,"^",8) ; time of last image

 S Z=Z_"|"_$P(LISTDATA,"^",9) ; time of last activity

 S Z=Z_"|"_(+$P(LISTDATA,"^",10)) ; #images

 S Z=Z_"|"_STATUS

 S Z=Z_"|"_$$GET1^DIQ(123,GMRCIEN,13,"I") ; consult/procedure flag

 S Z=Z_"|"_$P($$GET1^DIQ(123,GMRCIEN,5)," - ",2) ; GMRC urgency

 ;

 ; get inter-facility consult data

 S IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I") ; Routing Facility

 S IFCSITSN=$S(IFCSITE>0:$$STA^XUAF4(IFCSITE),1:"")  ; Routing Facility Station Number ; Supported IA #2171

 I IFCSITE D  ; inter-facility consult

 . S IFCIEN=$$GET1^DIQ(123,GMRCIEN,.06,"I") ; remote consult file entry

 . ; get IFC site abbreviation

 . S IFCSITEA=$S(IFCSITSN'="":IFCSITSN,1:"("_IFCSITE_")")  ; Station Number or (site IEN)

 . S IFCLTIME=$P(LISTDATA,"^",5),IFCRTIME=$P(LISTDATA,"^",6)

 . I IFCLTIME,IFCRTIME S IFCETIME=$$FMDIFF^XLFDT(IFCRTIME,IFCLTIME,2)

 . E  S IFCETIME=""

 . Q

 E  D  ; local consult

 . S (IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME)=""

 . Q

 S Z=Z_"|"_IFCSITE_"|"_IFCSITEA_"|"_IFCIEN

 S Z=Z_"|"_IFCLTIME_"|"_IFCRTIME_"|"_IFCETIME

 F I=12:1:16 S Z=Z_"|"_$P(LISTDATA,"^",I) ; reader identification

 S Z=Z_"|"_$P(LISTDATA,"^",17) ; start of reading

 S Z=Z_"|"_$P(LISTDATA,"^",18) ; end of reading

 S Z=Z_"|"_IFCSITSN  ; 

 S LAST=$G(OUT(1),1) ; first element in the array is the counter

 S LAST=LAST+1,OUT(LAST)=Z,OUT(1)=LAST

 Q

 ;

UNLOCKER ; automatically unlock any timed out studies

 N GMRCIEN

 N IFCSITE

 N SECONDS ;-- date/time in seconds

 N STATUS

 N UNLOCKTM ;- earliest date/time for a lock (FM format)

 N UNREAD ;--- pointer to entry in unread list

 N X

 ;

 ; calculate the earliest automatic unlock date/time

 S SECONDS=86400*$H+$P($H,",",2)-(60*LOCKTIME)

 ; convert to FM format

 S UNLOCKTM=$$HTFM^XLFDT((SECONDS\86400)_","_(SECONDS#86400),0)

 ;

 ; traverse the "lock list" and unlock those that have timed out

 F IPROC=1:1:$L(IPROCS,",") S IPROCIDX=$P(IPROCS,",",IPROC) D

 . S UNREAD=""

 . F  S UNREAD=$O(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"L",UNREAD)) Q:UNREAD=""  D

 . . S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))

 . . ; check for a lock timeout

 . . I $P(LISTDATA,"^",17)<UNLOCKTM D  ; lock timeout

 . . . ; only unlock studies that are to be done at the reading site

 . . . I DUZREAD2=$P(LISTDATA,"^",16) D UNLOCK^MAGDTR04(UNREAD,.STATUS)

 . . . Q

 . . Q

 . Q

 Q

 ;

SITEIEN(IEN,STNUMBER) ; Return Site IEN for station number STNUMBER if defined, otherwise IEN

 ; IEN      = Site IEN in INSTITUTION file (#4) e.g. 6001

 ; STNUMBER = Station number, e.g. 660AA. This could be blank. 

 N SITEIEN

 S SITEIEN=$$IEN^XUAF4($G(STNUMBER))  ; Supported IA #2171

 Q $S(SITEIEN>0:SITEIEN,1:$G(IEN,0))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---MAGDTR05   8291     printed  Mar 13, 2025@21:07:06                                                                                                                                                                                                    Page 2

MAGDTR05  ;WOIFO/PMK,JSL,SAF,NST - Read a DICOM image file ; 18 Jan 2013 10:44 AM

 +1       ;;3.0;IMAGING;**46,54,123,127**;Mar 19, 2002;Build 4231;Apr 01, 2013

 +2       ;; Per VHA Directive 2004-038, this routine should not be modified.

 +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      ;; | The Food and Drug Administration classifies this software as  |

 +11      ;; | a medical device.  As such, it may not be changed in any way. |

 +12      ;; | Modifications to this software may result in an adulterated   |

 +13      ;; | medical device under 21CFR820, the use of which is considered |

 +14      ;; | to be a violation of US Federal Statutes.                     |

 +15      ;; +---------------------------------------------------------------+

 +16      ;;

LOOKUP(OUT,STATNUMB,ISPECIDX,IPROCS,STARTING,DUZREAD,DUZREAD2,LOCKTIME,STATLIST,DUZRDSTN) ; RPC = MAG DICOM CON UNREADLIST GET

 +1       ; entry point to lookup entries in file

 +2       ; 

 +3       ; OUT ------- Return array

 +4       ; STATNUMB -- Acquisition Station Number

 +5       ; ISPECIDX -- Index to Specialties (2005.84)

 +6       ; IPROCS ---- Indexes to Procedures (2005.85) - this is a comma-delimited list

 +7       ; STARTING -- Fileman date/time to begin sequential search

 +8       ; DUZREAD --- User's DUZ at the Reading Site

 +9       ; DUZREAD2 -- DIC(4) pointer to Reading Site

 +10      ; LOCKTIME -- timeout value for LOCKTIME

 +11      ; STATLIST -- status of entry (C, L, R, U, or W, in any combination)

 +12      ; DUZRDSTN -- Station Number to Reading Site

 +13      ; 

 +14      ; DUZRDSTN (Station Number, e.g. 660AA) and DUZREAD2 (IEN in INSTITUTION file (#4), e.g. 6001) describe same site

 +15      ; Cannot switch to Station Number only. Old GUI client, before P127, sends DUZREAD2 (Site IEN) only

 +16      ;- site index in Unread List

           NEW ACQSITE

 +17      ;-- counter to the status in STATLIST

           NEW ISTATUS

 +18      ;---- counter to IPROCS

           NEW IPROC

 +19      ;- index to procedures (2005.85)

           NEW IPROCIDX

 +20      ;- last activity date/time for the entry

           NEW TIMESTMP

 +21      ;- name of acquisition site

           NEW SITENAME

 +22      ;-- one status out of the STATLIST

           NEW STATUS1

 +23      ;--- pointer to entry in unread list

           NEW UNREAD

 +24      ;

 +25       SET DUZREAD=$GET(DUZREAD,0)

 +26      ; Resolve the Reading Site Station number

           SET DUZREAD2=$$SITEIEN^MAGDTR05($GET(DUZREAD2),$GET(DUZRDSTN))

 +27       SET LOCKTIME=$GET(LOCKTIME,0)

 +28       SET STATLIST=$$UP^MAGDFCNV($GET(STATLIST))

 +29      ; default to all STATUS values

           IF STATLIST=""

               SET STATLIST="CDLRUW"

 +30      ;

 +31       SET ACQSITE=$$ACQSITE^MAGDTR06(STATNUMB)

 +32       IF ACQSITE<0

               SET OUT="-1, ACQUISITION STATION NUMBER "_STATNUMB_" IS NOT DEFINED IN FILE 4"

               QUIT 

 +33       SET SITENAME=$PIECE(ACQSITE,"^",2)

           SET ACQSITE=$PIECE(ACQSITE,"^",1)

 +34      ;

 +35      ; automatically unlock timed out studies

           IF LOCKTIME

               IF DUZREAD2

                   DO UNLOCKER

 +36      ;

 +37       KILL OUT

 +38      ; loop through the STATUS index because it is faster

           IF STARTING=0

               Begin DoDot:1

 +39      ; remove the DELETED status from STATLIST

                   SET STATLIST=$TRANSLATE(STATLIST,"D")

 +40               FOR ISTATUS=1:1:$LENGTH(STATLIST)

                       SET STATUS1=$EXTRACT(STATLIST,ISTATUS)

                       Begin DoDot:2

 +41                       FOR IPROC=1:1:$LENGTH(IPROCS,",")

                               SET IPROCIDX=$PIECE(IPROCS,",",IPROC)

                               Begin DoDot:3

 +42                               SET UNREAD=""

 +43                               FOR 

                                       SET UNREAD=$ORDER(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS1,UNREAD))

                                       if UNREAD=""

                                           QUIT 

                                       Begin DoDot:4

 +44                                       DO LOOKUP1(UNREAD)

 +45                                       QUIT 

                                       End DoDot:4

 +46                               QUIT 

                               End DoDot:3

 +47                       QUIT 

                       End DoDot:2

 +48               QUIT 

               End DoDot:1

 +49      ; retrieve just the latest events

          IF '$TEST

               Begin DoDot:1

 +50               FOR IPROC=1:1:$LENGTH(IPROCS,",")

                       SET IPROCIDX=$PIECE(IPROCS,",",IPROC)

                       Begin DoDot:2

 +51      ; reinitialize the starting date & time for each index to procedures

                           SET TIMESTMP=STARTING

 +52                       FOR 

                               SET TIMESTMP=$ORDER(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP))

                               if TIMESTMP=""

                                   QUIT 

                               Begin DoDot:3

 +53                               SET UNREAD=""

 +54                               FOR 

                                       SET UNREAD=$ORDER(^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,TIMESTMP,UNREAD))

                                       if UNREAD=""

                                           QUIT 

                                       Begin DoDot:4

 +55                                       DO LOOKUP1(UNREAD)

 +56                                       QUIT 

                                       End DoDot:4

 +57                               QUIT 

                               End DoDot:3

 +58                       QUIT 

                       End DoDot:2

 +59               QUIT 

               End DoDot:1

 +60       QUIT 

 +61      ;

LOOKUP1(UNREAD) ; retrieve one entry from the unread list

 +1        NEW GMRCIEN

 +2        NEW DFN

 +3        NEW VADM

 +4        NEW ICN

 +5        NEW IFCSITE,IFCSITSN,IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME

 +6       ;- read/unread list data

           NEW LISTDATA

 +7        NEW QUIT

 +8        NEW READER

 +9        NEW SHORTID

 +10       NEW STATUS

 +11       NEW VA,VADM,VAERR

 +12      ; VIP status

           NEW VIPSTS

 +13       NEW I,LAST,X,Z

 +14      ;

 +15       SET LISTDATA=$GET(^MAG(2006.5849,UNREAD,0))

 +16      ; status

           SET STATUS=$PIECE(LISTDATA,"^",11)

 +17      ; skip the entry if it is not the right STATUS

           if STATLIST'[STATUS

               QUIT 

 +18      ;

 +19       SET GMRCIEN=$PIECE(LISTDATA,"^",1)

 +20      ; Routing Facility

           SET IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I")

 +21      ;

 +22      ; check if this consult can it be displayed to the reader

 +23       SET QUIT=0

 +24       IF DUZREAD

               Begin DoDot:1

 +25      ; IFC reading site

                   IF IFCSITE

                       Begin DoDot:2

 +26                       IF IFCSITE'=DUZREAD2

                               SET QUIT=1

 +27                       QUIT 

                       End DoDot:2

                       if QUIT

                           QUIT 

 +28               IF STATUS="W"

                       SET QUIT=2

                       QUIT 

 +29               IF STATUS="L"

                       Begin DoDot:2

 +30      ; reader

                           SET READER=$PIECE(LISTDATA,"^",15)

 +31                       IF READER

                               IF READER'=DUZREAD

                                   SET QUIT=3

 +32                       QUIT 

                       End DoDot:2

                       if QUIT

                           QUIT 

 +33               QUIT 

               End DoDot:1

               if QUIT

                   QUIT 

 +34      ;

 +35      ; acquisition site identification

 +36       SET Z=UNREAD_"|"_GMRCIEN_"|"_STATNUMB_"|"_SITENAME

 +37      ; patient information

 +38       SET DFN=$$GET1^DIQ(123,GMRCIEN,.02,"I")

 +39      ; Supported IA (#10061)

           DO DEM^VADPT

 +40      ; IA #3027

           DO PTSEC^DGSEC4(.VIPSTS,DFN)

 +41      ; IA #2701

           SET ICN=$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(DFN),1:"-1^NO MPI")

 +42      ;P123

           SET X=$TRANSLATE(VA("PID"),"-","")

           SET SHORTID=$EXTRACT(VADM(1),1)_$EXTRACT(X,$LENGTH(X)-3,$LENGTH(X))

 +43      ;P123

           SET Z=Z_"|"_VADM(1)_"|"_VA("PID")_"|"_ICN_"|"_SHORTID

 +44      ; VIP status

           SET Z=Z_"|"_VIPSTS(1)

 +45       SET Z=Z_"|"_$PIECE(^MAG(2005.84,ISPECIDX,0),"^",1)_"|"_$PIECE(^MAG(2005.84,ISPECIDX,2),"^",1)

 +46       SET Z=Z_"|"_$PIECE(^MAG(2005.85,IPROCIDX,0),"^",1)_"|"_$PIECE(^MAG(2005.85,IPROCIDX,2),"^",1)

 +47      ; time stamps and image acquisition statistics

 +48      ; time of first image

           SET Z=Z_"|"_$PIECE(LISTDATA,"^",7)

 +49      ; time of last image

           SET Z=Z_"|"_$PIECE(LISTDATA,"^",8)

 +50      ; time of last activity

           SET Z=Z_"|"_$PIECE(LISTDATA,"^",9)

 +51      ; #images

           SET Z=Z_"|"_(+$PIECE(LISTDATA,"^",10))

 +52       SET Z=Z_"|"_STATUS

 +53      ; consult/procedure flag

           SET Z=Z_"|"_$$GET1^DIQ(123,GMRCIEN,13,"I")

 +54      ; GMRC urgency

           SET Z=Z_"|"_$PIECE($$GET1^DIQ(123,GMRCIEN,5)," - ",2)

 +55      ;

 +56      ; get inter-facility consult data

 +57      ; Routing Facility

           SET IFCSITE=$$GET1^DIQ(123,GMRCIEN,.07,"I")

 +58      ; Routing Facility Station Number ; Supported IA #2171

           SET IFCSITSN=$SELECT(IFCSITE>0:$$STA^XUAF4(IFCSITE),1:"")

 +59      ; inter-facility consult

           IF IFCSITE

               Begin DoDot:1

 +60      ; remote consult file entry

                   SET IFCIEN=$$GET1^DIQ(123,GMRCIEN,.06,"I")

 +61      ; get IFC site abbreviation

 +62      ; Station Number or (site IEN)

                   SET IFCSITEA=$SELECT(IFCSITSN'="":IFCSITSN,1:"("_IFCSITE_")")

 +63               SET IFCLTIME=$PIECE(LISTDATA,"^",5)

                   SET IFCRTIME=$PIECE(LISTDATA,"^",6)

 +64               IF IFCLTIME

                       IF IFCRTIME

                           SET IFCETIME=$$FMDIFF^XLFDT(IFCRTIME,IFCLTIME,2)

 +65              IF '$TEST

                       SET IFCETIME=""

 +66               QUIT 

               End DoDot:1

 +67      ; local consult

          IF '$TEST

               Begin DoDot:1

 +68               SET (IFCIEN,IFCSITEA,IFCRTIME,IFCLTIME,IFCETIME)=""

 +69               QUIT 

               End DoDot:1

 +70       SET Z=Z_"|"_IFCSITE_"|"_IFCSITEA_"|"_IFCIEN

 +71       SET Z=Z_"|"_IFCLTIME_"|"_IFCRTIME_"|"_IFCETIME

 +72      ; reader identification

           FOR I=12:1:16

               SET Z=Z_"|"_$PIECE(LISTDATA,"^",I)

 +73      ; start of reading

           SET Z=Z_"|"_$PIECE(LISTDATA,"^",17)

 +74      ; end of reading

           SET Z=Z_"|"_$PIECE(LISTDATA,"^",18)

 +75      ; 

           SET Z=Z_"|"_IFCSITSN

 +76      ; first element in the array is the counter

           SET LAST=$GET(OUT(1),1)

 +77       SET LAST=LAST+1

           SET OUT(LAST)=Z

           SET OUT(1)=LAST

 +78       QUIT 

 +79      ;

UNLOCKER  ; automatically unlock any timed out studies

 +1        NEW GMRCIEN

 +2        NEW IFCSITE

 +3       ;-- date/time in seconds

           NEW SECONDS

 +4        NEW STATUS

 +5       ;- earliest date/time for a lock (FM format)

           NEW UNLOCKTM

 +6       ;--- pointer to entry in unread list

           NEW UNREAD

 +7        NEW X

 +8       ;

 +9       ; calculate the earliest automatic unlock date/time

 +10       SET SECONDS=86400*$HOROLOG+$PIECE($HOROLOG,",",2)-(60*LOCKTIME)

 +11      ; convert to FM format

 +12       SET UNLOCKTM=$$HTFM^XLFDT((SECONDS\86400)_","_(SECONDS#86400),0)

 +13      ;

 +14      ; traverse the "lock list" and unlock those that have timed out

 +15       FOR IPROC=1:1:$LENGTH(IPROCS,",")

               SET IPROCIDX=$PIECE(IPROCS,",",IPROC)

               Begin DoDot:1

 +16               SET UNREAD=""

 +17               FOR 

                       SET UNREAD=$ORDER(^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"L",UNREAD))

                       if UNREAD=""

                           QUIT 

                       Begin DoDot:2

 +18                       SET LISTDATA=$GET(^MAG(2006.5849,UNREAD,0))

 +19      ; check for a lock timeout

 +20      ; lock timeout

                           IF $PIECE(LISTDATA,"^",17)<UNLOCKTM

                               Begin DoDot:3

 +21      ; only unlock studies that are to be done at the reading site

 +22                               IF DUZREAD2=$PIECE(LISTDATA,"^",16)

                                       DO UNLOCK^MAGDTR04(UNREAD,.STATUS)

 +23                               QUIT 

                               End DoDot:3

 +24                       QUIT 

                       End DoDot:2

 +25               QUIT 

               End DoDot:1

 +26       QUIT 

 +27      ;

SITEIEN(IEN,STNUMBER) ; Return Site IEN for station number STNUMBER if defined, otherwise IEN

 +1       ; IEN      = Site IEN in INSTITUTION file (#4) e.g. 6001

 +2       ; STNUMBER = Station number, e.g. 660AA. This could be blank. 

 +3        NEW SITEIEN

 +4       ; Supported IA #2171

           SET SITEIEN=$$IEN^XUAF4($GET(STNUMBER))

 +5        QUIT $SELECT(SITEIEN>0:SITEIEN,1:$GET(IEN,0))