| 1 | MAGDTR02 ;WOIFO/PMK - Unread List for Consult/Procedure Request ; 10 Oct 2006  11:01 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 |  ;;
 | 
|---|
| 18 | FORWARD ; entry point from ^MAGDT01 for a FORWARD request
 | 
|---|
| 19 |  N FWDFROM ;-- forwarded from service
 | 
|---|
| 20 |  N ISPECIDX ;- index to specialties - read/unread list sort key
 | 
|---|
| 21 |  N IPROCIDX ;- index to procedures - read/unread list sort key (may be null)
 | 
|---|
| 22 |  N LISTDATA ;- read/unread list data
 | 
|---|
| 23 |  N UNREAD ;--- pointer to an entry in the read/unread list
 | 
|---|
| 24 |  N OUNREAD,NUNREAD ; old and new unread list dictionary pointers
 | 
|---|
| 25 |  N OACQSITE,NACQSITE ; old and new unread list acquisition sites
 | 
|---|
| 26 |  N OPROCIDX,NPROCIDX ; old and new unread list procedure indexes
 | 
|---|
| 27 |  N OSPECIDX,NSPECIDX ; old and new unread list specialty indexes
 | 
|---|
| 28 |  N NEWENTRY ; - pointer to new entry in unread list
 | 
|---|
| 29 |  N I,X
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  ; get previous service from REQUEST PROCESSING ACTIVITY
 | 
|---|
| 32 |  S FWDFROM=$$FWDFROM^MAGDGMRC(GMRCIEN) ; FORWARDED FROM service
 | 
|---|
| 33 |  S OUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.OSPECIDX,.OPROCIDX,.OACQSITE,,,FWDFROM)
 | 
|---|
| 34 |  S NUNREAD=$$FINDLIST^MAGDTR01(GMRCIEN,.NSPECIDX,.NPROCIDX,.NACQSITE)
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 |  I 'OUNREAD,'NUNREAD Q  ; neither old nor new TO SERVICE have unread lists
 | 
|---|
| 37 |  ;
 | 
|---|
| 38 |  I 'OUNREAD,NUNREAD D  Q  ; only new TO SERVICE has an unread list
 | 
|---|
| 39 |  . N D0,IMAGECNT,MAGIEN,TRIGGER
 | 
|---|
| 40 |  . S IMAGECNT=0
 | 
|---|
| 41 |  . ; count the number of images, if any
 | 
|---|
| 42 |  . S D0="" F  S D0=$O(^MAG(2006.5839,"C",123,GMRCIEN,D0)) Q:'D0  D
 | 
|---|
| 43 |  . . S MAGIEN=$P($G(^MAG(2006.5839,D0,0)),"^",3)
 | 
|---|
| 44 |  . . I MAGIEN D  ; make sure you got a good group pointer
 | 
|---|
| 45 |  . . . ; get #images from Object Group file (2005.04)
 | 
|---|
| 46 |  . . . S IMAGECNT=IMAGECNT+$P($G(^MAG(2005,MAGIEN,1,0)),"^",4)
 | 
|---|
| 47 |  . . . Q
 | 
|---|
| 48 |  . . Q
 | 
|---|
| 49 |  . S TRIGGER=$S(IMAGECNT:"I",1:"")_"OF"
 | 
|---|
| 50 |  . ; create the new unread list entry
 | 
|---|
| 51 |  . D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,TRIGGER,IMAGECNT)
 | 
|---|
| 52 |  . Q
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 |  I OUNREAD,'NUNREAD D  Q  ; only old TO SERVICE has an unread list
 | 
|---|
| 55 |  . S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
 | 
|---|
| 56 |  . S X=$$STATUPDT^MAGDTR02(UNREAD,"D") ; set status of old entry to DELETE
 | 
|---|
| 57 |  . Q
 | 
|---|
| 58 |  ;
 | 
|---|
| 59 |  ; both the old TO SERVICE and the new TO SERVICE have unread lists
 | 
|---|
| 60 |  ; 
 | 
|---|
| 61 |  ; are the old and new unread lists the same?
 | 
|---|
| 62 |  ;
 | 
|---|
| 63 |  S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN)
 | 
|---|
| 64 |  I OACQSITE=NACQSITE,OSPECIDX=NSPECIDX,OPROCIDX=NPROCIDX D  Q
 | 
|---|
| 65 |  . ; exactly the same unread lists for old and new TO SERVICES
 | 
|---|
| 66 |  . I UNREAD S X=$$TIMESTMP^MAGDTR02(UNREAD) ; update the timestamp
 | 
|---|
| 67 |  . Q
 | 
|---|
| 68 |  ;
 | 
|---|
| 69 |  ; different unread lists for old and new TO SERVICES
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 |  ; is there an old unread list?
 | 
|---|
| 72 |  S LISTDATA=$S(UNREAD:$G(^MAG(2006.5849,UNREAD,0)),1:"")
 | 
|---|
| 73 |  I LISTDATA="" D  Q  ; no old unread list
 | 
|---|
| 74 |  . D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"OF") ; create the new unread list entry
 | 
|---|
| 75 |  . Q
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 |  ; there is an old unread list entry
 | 
|---|
| 78 |  ; create the new unread list and copy the data from the old unread list entry
 | 
|---|
| 79 |  S X=$$STATUPDT^MAGDTR02(UNREAD,"D")
 | 
|---|
| 80 |  D ADD^MAGDTR03(.NEWENTRY,GMRCIEN,"IOF") Q:'NEWENTRY  ; create the new unread list entry
 | 
|---|
| 81 |  F I=7,8,10 D  ; copy acquisition start, next acquisition, and number of images
 | 
|---|
| 82 |  . S $P(^MAG(2006.5849,NEWENTRY,0),"^",I)=$P(^MAG(2006.5849,UNREAD,0),"^",I)
 | 
|---|
| 83 |  . Q
 | 
|---|
| 84 |  Q
 | 
|---|
| 85 |  ;
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  ; common functions
 | 
|---|
| 88 |  ;
 | 
|---|
| 89 | UNREAD(GMRCIEN) ; look up unread list internal entry number
 | 
|---|
| 90 |  N HIT,LISTDATA,UNREAD,STATUS
 | 
|---|
| 91 |  Q:'$G(GMRCIEN) ""
 | 
|---|
| 92 |  S UNREAD="",HIT=0
 | 
|---|
| 93 |  F  S UNREAD=$O(^MAG(2006.5849,"B",GMRCIEN,UNREAD)) Q:'UNREAD  D  Q:HIT
 | 
|---|
| 94 |  . S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
 | 
|---|
| 95 |  . S STATUS=$P(LISTDATA,"^",11)
 | 
|---|
| 96 |  . I STATUS'="D" S HIT=1 ; ignore deleted entries
 | 
|---|
| 97 |  . Q
 | 
|---|
| 98 |  Q UNREAD
 | 
|---|
| 99 |  ;
 | 
|---|
| 100 | STATUPDT(UNREAD,STATUS) ; update the status
 | 
|---|
| 101 |  N ACQSITE,IPROCIDX,ISPECIDX,OSTATUS,LISTDATA,TIMESTMP
 | 
|---|
| 102 |  S TIMESTMP=0
 | 
|---|
| 103 |  I $G(UNREAD),$G(STATUS)'="",$D(^MAG(2006.5849,UNREAD,0)) D
 | 
|---|
| 104 |  . S LISTDATA=$G(^MAG(2006.5849,UNREAD,0))
 | 
|---|
| 105 |  . S ACQSITE=$P(LISTDATA,"^",2) Q:ACQSITE=""
 | 
|---|
| 106 |  . S ISPECIDX=$P(LISTDATA,"^",3) Q:ISPECIDX=""
 | 
|---|
| 107 |  . S IPROCIDX=$P(LISTDATA,"^",4) Q:IPROCIDX=""
 | 
|---|
| 108 |  . S OSTATUS=$P(LISTDATA,"^",11) Q:OSTATUS=""
 | 
|---|
| 109 |  . K ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,OSTATUS,UNREAD)
 | 
|---|
| 110 |  . S $P(^MAG(2006.5849,UNREAD,0),"^",11)=STATUS
 | 
|---|
| 111 |  . S ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,STATUS,UNREAD)=""
 | 
|---|
| 112 |  . S TIMESTMP=$$TIMESTMP^MAGDTR02(UNREAD) ; update time stamp piece of last activity
 | 
|---|
| 113 |  . Q
 | 
|---|
| 114 |  Q TIMESTMP
 | 
|---|
| 115 |  ; 
 | 
|---|
| 116 | TIMESTMP(UNREAD) ; update the transaction's timestamp and cross-reference
 | 
|---|
| 117 |  N ACQSITE ;-- acquisition site
 | 
|---|
| 118 |  N NEWTIME ;-- time stamp of the current transaction
 | 
|---|
| 119 |  N OLDTIME ;-- time stamp of the previous transaction
 | 
|---|
| 120 |  N LISTDATA ;- read/unread list data
 | 
|---|
| 121 |  N ISPECIDX ;- index to specialties - read/unread list sort key
 | 
|---|
| 122 |  N IPROCIDX ;- index to procedures - read/unread list sort key (may be null)
 | 
|---|
| 123 |  N %,%H,%I
 | 
|---|
| 124 |  Q:'$G(UNREAD) ""
 | 
|---|
| 125 |  D NOW^%DTC S NEWTIME=%
 | 
|---|
| 126 |  L +^MAG(2006.5849,UNREAD):1E9
 | 
|---|
| 127 |  S LISTDATA=^MAG(2006.5849,UNREAD,0)
 | 
|---|
| 128 |  S ACQSITE=$P(LISTDATA,"^",2) I ACQSITE="" Q 0
 | 
|---|
| 129 |  S ISPECIDX=$P(LISTDATA,"^",3) I ISPECIDX="" Q 0
 | 
|---|
| 130 |  S IPROCIDX=$P(LISTDATA,"^",4) I IPROCIDX="" Q 0
 | 
|---|
| 131 |  S OLDTIME=$P(LISTDATA,"^",9)
 | 
|---|
| 132 |  I ACQSITE'="",ISPECIDX'="",IPROCIDX'="" D
 | 
|---|
| 133 |  . K:OLDTIME ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,OLDTIME,UNREAD)
 | 
|---|
| 134 |  . S ^MAG(2006.5849,"AC",ACQSITE,ISPECIDX,IPROCIDX,NEWTIME,UNREAD)=""
 | 
|---|
| 135 |  . Q
 | 
|---|
| 136 |  S $P(^MAG(2006.5849,UNREAD,0),"^",9)=NEWTIME
 | 
|---|
| 137 |  L -^MAG(2006.5849,UNREAD)
 | 
|---|
| 138 |  Q NEWTIME
 | 
|---|