source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDTR02.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: 5.8 KB
Line 
1MAGDTR02 ;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 ;;
18FORWARD ; 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 ;
89UNREAD(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 ;
100STATUPDT(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 ;
116TIMESTMP(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
Note: See TracBrowser for help on using the repository browser.