MAGDTR02 ;WOIFO/PMK/MKN - Unread List for Consult/Procedure Request ; April 13, 2023
;;3.0;IMAGING;**46,54,353**;Mar 19, 2002;Build 7
;; Per VA Directive 6402, 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. |
;; +---------------------------------------------------------------+
;;
FORWARD ; entry point from ^MAGDT01 for a FORWARD request
N FWDFROM ;-- forwarded from service
N ISPECIDX ;- index to specialties - read/unread list sort key
N IPROCIDX ;- index to procedures - read/unread list sort key (may be null)
N LISTDATA ;- read/unread list data
N UNREAD ;--- pointer to an entry in the read/unread list
N OUNREAD,NUNREAD ; old and new unread list dictionary pointers
N OACQSITE,NACQSITE ; old and new unread list acquisition sites
N OPROCIDX,NPROCIDX ; old and new unread list procedure indexes
N OSPECIDX,NSPECIDX ; old and new unread list specialty indexes
N NEWENTRY ; - pointer to new entry in unread list
N I,X
;
; get previous service from REQUEST PROCESSING ACTIVITY
S FWDFROM=$$FWDFROM^MAGDGMRC(GMRCIEN) ; FORWARDED FROM service
S OUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.OSPECIDX,.OPROCIDX,.OACQSITE,,,FWDFROM)
S NUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.NSPECIDX,.NPROCIDX,.NACQSITE)
;
I 'OUNREAD,'NUNREAD Q ; neither old nor new TO SERVICE have unread lists
;
I 'OUNREAD,NUNREAD D Q ; only new TO SERVICE has an unread list
. N D0,IMAGECNT,MAGIEN,TRIGGER
. S IMAGECNT=0
. ; count the number of images, if any
. S D0="" F S D0=$O(^MAG(2006.5839,"C",123,GMRCIEN,D0)) Q:'D0 D
. . S MAGIEN=$P($G(^MAG(2006.5839,D0,0)),"^",3)
. . I MAGIEN D ; make sure you got a good group pointer
. . . ; get #images from Object Group file (2005.04)
. . . S IMAGECNT=IMAGECNT+$P($G(^MAG(2005,MAGIEN,1,0)),"^",4)
. . . Q
. . Q
. S TRIGGER=$S(IMAGECNT:"I",1:"")_"OF"
. ; create the new unread list entry
. D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,TRIGGER,IMAGECNT)
. Q
;
I OUNREAD,'NUNREAD D Q ; only old TO SERVICE has an unread list
. S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
. S X=$$STATUPDT^MAGDTR02(UNREAD,"D") ; set status of old entry to DELETE
. Q
;
; both the old TO SERVICE and the new TO SERVICE have unread lists
;
; are the old and new unread lists the same?
;
S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
I OACQSITE=NACQSITE,OSPECIDX=NSPECIDX,OPROCIDX=NPROCIDX D Q
. ; exactly the same unread lists for old and new TO SERVICES
. I UNREAD S X=$$TIMESTMP^MAGDTR02(UNREAD) ; update the timestamp
. Q
;
; different unread lists for old and new TO SERVICES
;
; is there an old unread list?
S LISTDATA=$S(UNREAD:$G(^MAG(2006.5849,UNREAD,0)),1:"")
I LISTDATA="" D Q ; no old unread list
. D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"OF") ; create the new unread list entry
. Q
;
; there is an old unread list entry
; create the new unread list and copy the data from the old unread list entry
S X=$$STATUPDT^MAGDTR02(UNREAD,"D")
D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"IOF") Q:'NEWENTRY ; create the new unread list entry
F I=7,8,10 D ; copy acquisition start, next acquisition, and number of images
. S $P(^MAG(2006.5849,NEWENTRY,0),"^",I)=$P(^MAG(2006.5849,UNREAD,0),"^",I)
. Q
Q
;
;
; common functions
;
UNREAD(GMRCIEN) ; look up unread list internal entry number
N HIT,LISTDATA,UNREAD,STATUS
Q:'$G(GMRCIEN) ""
S UNREAD="",HIT=0
F S UNREAD=$O(^MAG(2006.5849,"B",GMRCIEN,UNREAD)) Q:'UNREAD D Q:HIT
. S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
. S STATUS=$P(LISTDATA,"^",11)
. I STATUS'="D" S HIT=1 ; ignore deleted entries
. Q
Q UNREAD
;
STATUPDT(UNREAD,STATUS) ; update the status
N ACQSITE,IPROCIDX,ISPECIDX,OSTATUS,LISTDATA,TIMESTMP
S TIMESTMP=0
I $G(UNREAD),$G(STATUS)'="",$D(^MAG(2006.5849,UNREAD,0)) D
. S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
. S ACQSITE=$P(LISTDATA,"^",2) Q:ACQSITE=""
. S ISPECIDX=$P(LISTDATA,"^",3) Q:ISPECIDX=""
. S IPROCIDX=$P(LISTDATA,"^",4) Q:IPROCIDX=""
. S OSTATUS=$P(LISTDATA,"^",11) Q:OSTATUS=""
. K ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,OSTATUS,UNREAD)
. S $P(^MAG(2006.5849,UNREAD,0),"^",11)=STATUS
. S ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS,UNREAD)=""
. S TIMESTMP=$$TIMESTMP^MAGDTR02(UNREAD) ; update time stamp piece of last activity
. Q
Q TIMESTMP
;
TIMESTMP(UNREAD) ; update the transaction's timestamp and cross-reference
N ACQSITE ;-- acquisition site
N NEWTIME ;-- time stamp of the current transaction
N OLDTIME ;-- time stamp of the previous transaction
N LISTDATA ;- read/unread list data
N ISPECIDX ;- index to specialties - read/unread list sort key
N IPROCIDX ;- index to procedures - read/unread list sort key (may be null)
Q:'$G(UNREAD) ""
S NEWTIME=$$NOW^XLFDT()
L +^MAG(2006.5849,UNREAD):1E9
S LISTDATA=^MAG(2006.5849,UNREAD,0)
S ACQSITE=$P(LISTDATA,"^",2) I ACQSITE="" Q 0
S ISPECIDX=$P(LISTDATA,"^",3) I ISPECIDX="" Q 0
S IPROCIDX=$P(LISTDATA,"^",4) I IPROCIDX="" Q 0
S OLDTIME=$P(LISTDATA,"^",9)
I ACQSITE'="",ISPECIDX'="",IPROCIDX'="" D
. K:OLDTIME ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,OLDTIME,UNREAD)
. S ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,NEWTIME,UNREAD)=""
. Q
I $P(^MAG(2006.5849,UNREAD,0),"^",9)="" S $P(^(0),"^",9)=NEWTIME ;P353 - assign timestamp only if field is null
L -^MAG(2006.5849,UNREAD)
Q NEWTIME
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDTR02 6169 printed Nov 22, 2024@17:12:15 Page 2
MAGDTR02 ;WOIFO/PMK/MKN - Unread List for Consult/Procedure Request ; April 13, 2023
+1 ;;3.0;IMAGING;**46,54,353**;Mar 19, 2002;Build 7
+2 ;; Per VA Directive 6402, 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 ;;
FORWARD ; entry point from ^MAGDT01 for a FORWARD request
+1 ;-- forwarded from service
NEW FWDFROM
+2 ;- index to specialties - read/unread list sort key
NEW ISPECIDX
+3 ;- index to procedures - read/unread list sort key (may be null)
NEW IPROCIDX
+4 ;- read/unread list data
NEW LISTDATA
+5 ;--- pointer to an entry in the read/unread list
NEW UNREAD
+6 ; old and new unread list dictionary pointers
NEW OUNREAD,NUNREAD
+7 ; old and new unread list acquisition sites
NEW OACQSITE,NACQSITE
+8 ; old and new unread list procedure indexes
NEW OPROCIDX,NPROCIDX
+9 ; old and new unread list specialty indexes
NEW OSPECIDX,NSPECIDX
+10 ; - pointer to new entry in unread list
NEW NEWENTRY
+11 NEW I,X
+12 ;
+13 ; get previous service from REQUEST PROCESSING ACTIVITY
+14 ; FORWARDED FROM service
SET FWDFROM=$$FWDFROM^MAGDGMRC(GMRCIEN)
+15 SET OUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.OSPECIDX,.OPROCIDX,.OACQSITE,,,FWDFROM)
+16 SET NUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.NSPECIDX,.NPROCIDX,.NACQSITE)
+17 ;
+18 ; neither old nor new TO SERVICE have unread lists
IF 'OUNREAD
IF 'NUNREAD
QUIT
+19 ;
+20 ; only new TO SERVICE has an unread list
IF 'OUNREAD
IF NUNREAD
Begin DoDot:1
+21 NEW D0,IMAGECNT,MAGIEN,TRIGGER
+22 SET IMAGECNT=0
+23 ; count the number of images, if any
+24 SET D0=""
FOR
SET D0=$ORDER(^MAG(2006.5839,"C",123,GMRCIEN,D0))
if 'D0
QUIT
Begin DoDot:2
+25 SET MAGIEN=$PIECE($GET(^MAG(2006.5839,D0,0)),"^",3)
+26 ; make sure you got a good group pointer
IF MAGIEN
Begin DoDot:3
+27 ; get #images from Object Group file (2005.04)
+28 SET IMAGECNT=IMAGECNT+$PIECE($GET(^MAG(2005,MAGIEN,1,0)),"^",4)
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 SET TRIGGER=$SELECT(IMAGECNT:"I",1:"")_"OF"
+32 ; create the new unread list entry
+33 DO ADD^MAGDTR03(.NEWENTRY,GMRCIEN,TRIGGER,IMAGECNT)
+34 QUIT
End DoDot:1
QUIT
+35 ;
+36 ; only old TO SERVICE has an unread list
IF OUNREAD
IF 'NUNREAD
Begin DoDot:1
+37 SET UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
+38 ; set status of old entry to DELETE
SET X=$$STATUPDT^MAGDTR02(UNREAD,"D")
+39 QUIT
End DoDot:1
QUIT
+40 ;
+41 ; both the old TO SERVICE and the new TO SERVICE have unread lists
+42 ;
+43 ; are the old and new unread lists the same?
+44 ;
+45 SET UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
+46 IF OACQSITE=NACQSITE
IF OSPECIDX=NSPECIDX
IF OPROCIDX=NPROCIDX
Begin DoDot:1
+47 ; exactly the same unread lists for old and new TO SERVICES
+48 ; update the timestamp
IF UNREAD
SET X=$$TIMESTMP^MAGDTR02(UNREAD)
+49 QUIT
End DoDot:1
QUIT
+50 ;
+51 ; different unread lists for old and new TO SERVICES
+52 ;
+53 ; is there an old unread list?
+54 SET LISTDATA=$SELECT(UNREAD:$GET(^MAG(2006.5849,UNREAD,0)),1:"")
+55 ; no old unread list
IF LISTDATA=""
Begin DoDot:1
+56 ; create the new unread list entry
DO ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"OF")
+57 QUIT
End DoDot:1
QUIT
+58 ;
+59 ; there is an old unread list entry
+60 ; create the new unread list and copy the data from the old unread list entry
+61 SET X=$$STATUPDT^MAGDTR02(UNREAD,"D")
+62 ; create the new unread list entry
DO ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"IOF")
if 'NEWENTRY
QUIT
+63 ; copy acquisition start, next acquisition, and number of images
FOR I=7,8,10
Begin DoDot:1
+64 SET $PIECE(^MAG(2006.5849,NEWENTRY,0),"^",I)=$PIECE(^MAG(2006.5849,UNREAD,0),"^",I)
+65 QUIT
End DoDot:1
+66 QUIT
+67 ;
+68 ;
+69 ; common functions
+70 ;
UNREAD(GMRCIEN) ; look up unread list internal entry number
+1 NEW HIT,LISTDATA,UNREAD,STATUS
+2 if '$GET(GMRCIEN)
QUIT ""
+3 SET UNREAD=""
SET HIT=0
+4 FOR
SET UNREAD=$ORDER(^MAG(2006.5849,"B",GMRCIEN,UNREAD))
if 'UNREAD
QUIT
Begin DoDot:1
+5 SET LISTDATA=$GET(^MAG(2006.5849,UNREAD,0))
+6 SET STATUS=$PIECE(LISTDATA,"^",11)
+7 ; ignore deleted entries
IF STATUS'="D"
SET HIT=1
+8 QUIT
End DoDot:1
if HIT
QUIT
+9 QUIT UNREAD
+10 ;
STATUPDT(UNREAD,STATUS) ; update the status
+1 NEW ACQSITE,IPROCIDX,ISPECIDX,OSTATUS,LISTDATA,TIMESTMP
+2 SET TIMESTMP=0
+3 IF $GET(UNREAD)
IF $GET(STATUS)'=""
IF $DATA(^MAG(2006.5849,UNREAD,0))
Begin DoDot:1
+4 SET LISTDATA=$GET(^MAG(2006.5849,UNREAD,0))
+5 SET ACQSITE=$PIECE(LISTDATA,"^",2)
if ACQSITE=""
QUIT
+6 SET ISPECIDX=$PIECE(LISTDATA,"^",3)
if ISPECIDX=""
QUIT
+7 SET IPROCIDX=$PIECE(LISTDATA,"^",4)
if IPROCIDX=""
QUIT
+8 SET OSTATUS=$PIECE(LISTDATA,"^",11)
if OSTATUS=""
QUIT
+9 KILL ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,OSTATUS,UNREAD)
+10 SET $PIECE(^MAG(2006.5849,UNREAD,0),"^",11)=STATUS
+11 SET ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS,UNREAD)=""
+12 ; update time stamp piece of last activity
SET TIMESTMP=$$TIMESTMP^MAGDTR02(UNREAD)
+13 QUIT
End DoDot:1
+14 QUIT TIMESTMP
+15 ;
TIMESTMP(UNREAD) ; update the transaction's timestamp and cross-reference
+1 ;-- acquisition site
NEW ACQSITE
+2 ;-- time stamp of the current transaction
NEW NEWTIME
+3 ;-- time stamp of the previous transaction
NEW OLDTIME
+4 ;- read/unread list data
NEW LISTDATA
+5 ;- index to specialties - read/unread list sort key
NEW ISPECIDX
+6 ;- index to procedures - read/unread list sort key (may be null)
NEW IPROCIDX
+7 if '$GET(UNREAD)
QUIT ""
+8 SET NEWTIME=$$NOW^XLFDT()
+9 LOCK +^MAG(2006.5849,UNREAD):1E9
+10 SET LISTDATA=^MAG(2006.5849,UNREAD,0)
+11 SET ACQSITE=$PIECE(LISTDATA,"^",2)
IF ACQSITE=""
QUIT 0
+12 SET ISPECIDX=$PIECE(LISTDATA,"^",3)
IF ISPECIDX=""
QUIT 0
+13 SET IPROCIDX=$PIECE(LISTDATA,"^",4)
IF IPROCIDX=""
QUIT 0
+14 SET OLDTIME=$PIECE(LISTDATA,"^",9)
+15 IF ACQSITE'=""
IF ISPECIDX'=""
IF IPROCIDX'=""
Begin DoDot:1
+16 if OLDTIME
KILL ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,OLDTIME,UNREAD)
+17 SET ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,NEWTIME,UNREAD)=""
+18 QUIT
End DoDot:1
+19 ;P353 - assign timestamp only if field is null
IF $PIECE(^MAG(2006.5849,UNREAD,0),"^",9)=""
SET $PIECE(^(0),"^",9)=NEWTIME
+20 LOCK -^MAG(2006.5849,UNREAD)
+21 QUIT NEWTIME
