source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJEX1A.m@ 1046

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

initial load of WorldVistAEHR
File size: 9.0 KB
RevLine 
[613]1MAGJEX1A ;WIRMFO/JHC VistARad RPCs, exam locking ; 15 Sep 2004 10:00 AM
2 ;;3.0;IMAGING;**18,65**;Jul 27, 2006;Build 28
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 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20 ; Entry Points:
21 ; CASLOCK--RPC: Lock mgt
22 ; LOCKACT--Subrtn
23 ; LOCKOUT--Subrtn
24 ;
25ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
26 D @^%ZOSF("ERRTN")
27 Q:$Q 1 Q
28 ;
29CASLOCK(MAGGRY,DATA) ; RPC Call: MAGJ RADCASELOCKS
30 ; MAGGRY holds $NA reference to ^TMP for rpc reply; all ref's to MAGGRY use ss indirection
31 ; input in DATA: OPEN_FLAG^RADFN^RADTI^RACNI^RARPT
32 ; OPEN_FLAG = 3: Reserve-to-Lock; 4: Lock-to-Reserve; 5: Lock/Take
33 ; RADFN^, etc--exam id
34 ;
35 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1A"
36 N RARPT,RADFN,RADTI,RACNI,DIQUIET,CURCASE,REPLY,CT,DATAOUT,MAGLST,XX
37 N DAYCASE,LOCKED,RACN,RADTE,MAGS,LOGDATA,RESULT,MYLOCK,GOTLOCK
38 S DIQUIET=1 D DT^DICRW
39 S CT=0,DATAOUT="",DAYCASE="",MAGLST="MAGJCASELOCK"
40 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY
41 S CURCASE=+$P(DATA,U)
42 S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4),RARPT=+$P(DATA,U,5)
43 I "^3^4^5^"[(U_CURCASE_U)
44 E S REPLY="4~Invalid Caselock request ("_DATA_")." G CASLOCKZ
45 I RADFN,RADTI,RACNI,RARPT
46 E S REPLY="4~Caselock Request contains invalid Case Pointer ("_DATA_")." G CASLOCKZ
47 S XX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
48 S RACN=$P(XX,U)
49 S RADTE=9999999.9999-RADTI
50 S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
51 S X=$P(XX,U,3)
52 I '$D(^RA(72,"AVC","E",X)) D G CASLOCKZ
53 . N STS S STS=X
54 . D LOCKACT(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated
55 . I +RESULT(1)!+RESULT(2) D LOCKACT(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve
56 . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,STS,0),U)_"; Reserve/Lock change NOT allowed."
57 D LOCKACT(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY)
58 S GOTLOCK=+RESULT
59 D LOCKACT(RARPT,DAYCASE,100,.MYLOCK)
60 I GOTLOCK&+MYLOCK(1)&(CURCASE=3!(CURCASE=5)) D ; update Image access log if got the lock
61 . S LOGDATA=$P(MYLOCK(2),"|",2) ; was saved when the Reserve occurred
62 . I CURCASE=5 S $P(LOGDATA,U,4)=+MAGJOB("REMOTE") ; update "remote" indicator if was TAKEN
63 . D LOG^MAGJUTL3("VR-VW",LOGDATA)
64 . S $P(^XTMP("MAGJ","LOCK",RARPT,1,DAYCASE),"|",2)=LOGDATA ; save for Interp event
65 S DATAOUT=$S(+MYLOCK(1):1,+MYLOCK(2):2,1:0)
66 ;
67CASLOCKZ ;
68 S @MAGGRY@(0)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"_DATAOUT
69 Q
70 ;
71PNAM(X) ; return pt name for input DFN
72 I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U)
73 E S X="UNKNOWN"
74 Q X
75 ;
76LOCKACT(RARPT,DAYCASE,REQUEST,RESULT,ACTREPLY,LOGDATA) ; determine if desired lock action is feasible
77 ; Input: RARPT, DAYCASE, REQUEST, LOGDATA
78 ; REQUESTed Action:
79 ; 1-Lock; 2-Reserve; 3-ResToLock; 4-LockToRes; 5-TakeLock; 100-Status; 101-UNLOCK
80 ; Note: 100 & 101 are special for internal use only
81 ; LOGDATA--pass through for Image Access Log
82 ; Output: RESULT, ACTREPLY
83 ; RESULT: ACTION "allowed" = LOCK^RESERVE^ResToInt^IntToRes^Take^_"|"_ImgLst
84 ; these are truth values; Imglst true =~ return Image File list to client
85 ; RESULT is ultimately used at tag LOCKOUT
86 ; ACTREPLY --reply message for client logic/display
87 ;
88 N ACTION,LOCKLEV,MYLOCK
89 K RESULT S ACTION="",ACTREPLY="",RESULT="" S LOGDATA=$G(LOGDATA,"")
90 I '$P($G(^MAG(2006.69,1,0)),U,4) Q ; Status Updates not enabled
91 I REQUEST=100 D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.RESULT,"STATUS") G LOCKACTZ ; Lock Status check only
92 S ACTION="0^0^0^0^0|0"
93 D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.MYLOCK)
94 I REQUEST=101 D G LOCKACT1 ; Unlock exam
95 . M ACTREPLY=MYLOCK ; internal use by MAGJUPD1
96 I 'LOCKLEV D G LOCKACT1
97 . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Exam #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel
98 . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#0"
99 I LOCKLEV=3 D ; Is or Can be Reserved or Interp by me
100 . I MYLOCK(1) D Q ; Already Locked/TAKEN by me
101 . . I REQUEST=1 D Q
102 . . . I MAGJOB("P32") S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3)
103 . . . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already open/locked--no action taken"
104 . . I REQUEST=4 D Q ; Remove Lock, keep Reserve
105 . . . S $P(ACTION,U,2)=1,$P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked, reserved"
106 . . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#1"
107 . E I MYLOCK(2) D Q ; Already Reserved by me
108 . . I REQUEST=3 S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,U,3)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update (from reserve) by "_$P(MAGJOB("USER",1),U,3)
109 . . E I REQUEST=2 S $P(ACTION,U,2)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(2),U,6)_" already reserved--no action taken."
110 . . E S $P(ACTION,U,2)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#2"
111 . E D ; Available
112 . . I REQUEST=1 S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3)
113 . . E I REQUEST=2 S $P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~Exam #"_DAYCASE_" reserved."
114 . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#3"
115 E I LOCKLEV=1 D ; Reserved by other (I can Take, Except View/Take/Cancel)
116 . I MYLOCK(1) D Q
117 . . I REQUEST=1 D Q
118 . . . I MAGJOB("P32") S $P(ACTION,U)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3) ; should be impossible
119 . . . E S $P(ACTION,U)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
120 . . E I REQUEST=2 S $P(ACTION,U,1)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
121 . . ; <*> next line Unlocks ME, and preserves Other User's Reserve
122 . . E I REQUEST=4 S $P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked; reserved by "_$P(MYLOCK(2),U,4)_"."
123 . . E S $P(ACTION,U)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#5; Lock retained." ; preserve lock
124 . I 'MYLOCK D Q
125 . . I REQUEST=1 D Q
126 . . . I MAGJOB("P32") S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
127 . . . E S $P(ACTION,"|",2)=1,ACTREPLY="8~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"." ; #8=View/Take/Cancel"
128 . . E I REQUEST=2 S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
129 . . E I REQUEST=5 S $P(ACTION,U)=1,$P(ACTION,U,5)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") taken/locked for update by "_$P(MAGJOB("USER",1),U,3)
130 . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#6"
131 E I LOCKLEV=2 D ; Locked by another
132 . I MYLOCK(2) D Q
133 . . S $P(ACTION,U,3)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked (taken) by "_$P(MYLOCK(1),U,4)_"; reserve cancelled." ; View/Cancel"
134 . I 'MYLOCK D Q
135 . . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel"
136 . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#8"
137 ;
138LOCKACT1 D LOCKOUT(RARPT,DAYCASE,LOCKLEV,.MYLOCK,ACTION,.RESULT,LOGDATA)
139 ;
140LOCKACTZ Q
141 ;
142 ;
143LOCKOUT(RARPT,DAYCASE,LOCKLEV,MYLOCK,ACTION,RESULT,LOGDATA) ; Record Locks and Clear Locks, as required
144 ; Precursors are logic and data from tags LOCKIN^magjex1b and LOCKACT
145 S RESULT="" S LOGDATA=$G(LOGDATA,"")
146 Q:'LOCKLEV ; nothing to do
147 N ILOCK
148 F ILOCK=1,2 D ; 1:Lock 2:Reserve
149 . I ILOCK=1&(LOCKLEV=1!(LOCKLEV=3))
150 . E I ILOCK=2&(LOCKLEV=2!(LOCKLEV=3))
151 . E Q
152 . I MYLOCK(ILOCK) D ; NEVER change order of the logic below!
153 . . I '$P(ACTION,U,ILOCK) D
154 . . . K ^XTMP("MAGJ","LOCK",RARPT,ILOCK)
155 . . . S $P(RESULT,U,ILOCK)=0
156 . . L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset lock
157 . ; index by DayCase manages locks for Printset Exams (>1 DayCase for one RARPT)
158 . ; a lock on any printset member exam effectively locks all related exams
159 . I +$P(ACTION,U,ILOCK),'MYLOCK(ILOCK) D
160 . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK,DAYCASE)=DUZ_U_$J_U_$H_U_$P(MAGJOB("USER",1),U,2,3)_U_"|"_LOGDATA
161 . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK)=DAYCASE
162 . . S $P(RESULT,U,ILOCK)=1
163 . I '$P(ACTION,U,ILOCK) L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset or clear lock
164 Q
165 ;
166END Q ;
Note: See TracBrowser for help on using the repository browser.