source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJPRF1.m@ 1042

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

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1MAGJPRF1 ;WIRMFO/JHC VistaRad RPCs-User Prefs ; 05 May 2004 10:05 AM
2 ;;3.0;IMAGING;**18**;Mar 07, 2006
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 ;; | |
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 Q
19ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
20 D @^%ZOSF("ERRTN")
21 Q:$Q 1 Q
22 ;
23RPCIN(MAGGRY,PARAMS,DATA) ; RPC: MAGJ USER DATA
24 ;PARAMS: TXID ^ SYSUPDAT ^ TXDUZ ^ TXDIV
25 ;TXID: Req'd--action to take; see below
26 ;TXDUZ: Opt; if input, get data for another user
27 ;TXDIV: Opt; if input, get data for another div
28 ;SYSUPDAT: Opt; if input, save Sys Default data; Sec Key Req'd
29 ; DATA--(opt) input array; depends on TXID; see subs by TXID
30 ;Pattern for DATA input & reply is:
31 ;*LABEL ; Start for one label
32 ;Label_Name ; label name
33 ;(1:N lines of XML text follow)
34 ;*END ; end for label
35 ;*LABEL ; Start for next label (etc.)
36 ;Label_Name_2
37 ;*KEY ; index keys to follow (KEY data is opt)
38 ;KeyNam1=nnn ; 1st key (free-text)
39 ;KeyNam2=jjj ; 2nd key (etc.)
40 ;*END_KEY ; end of keys
41 ; (1:N lines of XML text follow)
42 ;*END ; end for label
43 ;
44 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJPRF1"
45 N GPREF,MAGLST,PREFIEN,REPLY,TXTYPE,PDIV,TXDUZ,TXID,TXDIV,READONLY,SYSUPDAT
46 S TXID=+PARAMS,SYSUPDAT=+$P(PARAMS,U,2),TXDUZ=$P(PARAMS,U,3),TXDIV=+$P(PARAMS,U,4)
47 S MAGLST="MAGJRPC" K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
48 S DIQUIET=1 D DT^DICRW
49 ; no updates allowed if read another user's data, or get data for another logon division
50 I 'TXDUZ,(TXDUZ="sysAdmin") S TXDUZ=$$SYSUSER()
51 I 'TXDUZ S TXDUZ=DUZ
52 I 'TXDIV S TXDIV=DUZ(2)
53 S READONLY=(TXDUZ'=DUZ)
54 ; I 'READONLY S READONLY=(TXDIV'=DUZ(2)) ; <*> ?? Put this check inside Div-sensitive operations <*>
55 I READONLY,$D(MAGJOB("KEYS","MAGJ SYSTEM USER")),SYSUPDAT,(TXDUZ=$$SYSUSER()) S READONLY=0 ; get/update SysDefault data
56 S PREFIEN=$$GETPRIEN(TXDUZ,READONLY)
57 I 'PREFIEN S REPLY="0~Unable to get/update user data ("_$$USER(TXDUZ)_") for MAGJ USER DATA rpc call." G RPCINZ
58 ; set this level based on the TXID
59 S TXID=+$G(TXID)
60 ;
61 S TXTYPE="VR-WS",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV=""
62 ; workstation settings, user preferences, etc.
63 I TXID=1 G:'READONLY SAVE S REPLY="Access for updating preferences denied." G RPCINZ ; Store prefs by label
64 I TXID=2 G TAGS ; Get Labels w/ assoc. Keys
65 I TXID=3 G PRFDATA ; Get pref data for labels
66 I TXID=4 G:'READONLY TAGDEL S REPLY="Access for deleting preferences denied." G RPCINZ ; Delete labels
67 I TXID=6 G USERS ; Get list of vrad users, including SysAdmin
68 ;
69 S TXTYPE="VR-HP",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV="" ; Hanging Protocols
70 I TXID=11 G:'READONLY SAVE S REPLY="Access for updating Hanging Protocols denied." G RPCINZ ; Store HP by label
71 I TXID=12 G TAGS ; Get HP Labels
72 I TXID=13 G PRFDATA ; Get data for HP labels
73 I TXID=14 G:'READONLY TAGDEL S REPLY="Access for deleting Hanging Protocol denied." G RPCINZ ; Delete HP labels
74 ;
75 E S REPLY="0~Invalid transaction (TX="_TXID_") requested by MAGJ USER DATA rpc call."
76RPCINZ S @MAGGRY@(0)=0_U_REPLY
77 Q
78 ;
79GETPRIEN(DUZ,READONLY) ; Lookup/create User Pref entry for input DUZ
80 ; READONLY: True for lookup-only (no create)
81 N T,X,PREFIEN
82 S PREFIEN=$O(^MAG(2006.68,"AC",+DUZ,"")) I 'PREFIEN,'READONLY D
83 . L +^MAG(2006.68,0):10
84 . E Q
85 . S X=$G(^MAG(2006.68,0))
86 . S PREFIEN=+$P(X,U,3)
87 . F S PREFIEN=PREFIEN+1 I '$D(^MAG(2006.68,PREFIEN)) Q
88 . S T=$P(X,U,4)+1,$P(X,U,3)=PREFIEN,$P(X,U,4)=T
89 . S ^MAG(2006.68,0)=X
90 . S T=$$USER(+DUZ),^MAG(2006.68,PREFIEN,0)=$P(T,U)_U_+DUZ_U_$P(T,U,3)
91 . S ^MAG(2006.68,"B",$P(T,U),PREFIEN)=""
92 . S ^MAG(2006.68,"AC",+DUZ,PREFIEN)=""
93 . L -^MAG(2006.68,0)
94 Q PREFIEN
95 ;
96SAVE ; Save User Pref data by Label
97 N NEWTAG,STUFF,LINCT,LBLCT,DUMMY,KEYS
98 S NEWTAG=0,STUFF=0,LINCT=0,LBLCT=0,DUMMY=0,KEYS=0
99 S IDATA=""
100 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S LINE=DATA(IDATA) I LINE]"" D
101 . I LINE="*LABEL" S NEWTAG=1,STUFF=0 Q
102 . I LINE="*END" S NEWTAG=0,STUFF=0 Q
103 . I NEWTAG S TAG=LINE D TAGINIT(TAG) Q ; Init the storage for this tag
104 . I 'STUFF S TAG="*DUM" D TAGINIT(TAG) ; got text line w/out prior label; init dummy tag
105 . S TAGCT=TAGCT+1,@GPREF@(TAGIEN,1,TAGCT,0)=LINE,LINCT=LINCT+1
106 . S $P(@GPREF@(TAGIEN,1,0),U,3,4)=TAGCT_U_TAGCT
107 . I TAG="*DUM" S LINCT=LINCT-1 ; don't count dummy lines/labels
108 . I LINE="*KEY" S KEYS=1
109 . I KEYS D
110 . . S KEYCT=+$P($G(@GPREF@(TAGIEN,2,0)),U,4)+1,^(0)="^2006.6823^"_KEYCT_U_KEYCT
111 . . S @GPREF@(TAGIEN,2,KEYCT,0)=LINE
112 . I LINE="*END_KEY" S KEYS=0
113SAVEZ I LINCT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" were stored for "_LBLCT_" label"_$S(LBLCT-1:"s.",1:".")
114 E S REPLY="0~No data was stored."
115 S @MAGGRY@(0)=0_U_REPLY
116 I DUMMY ; n/a
117 Q
118TAGINIT(TAG) ; Init storage space for a tag; inits some vars for SAVE
119 N TAGCTRL
120 I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by division
121 S TAGIEN=$O(@GPREF@("B",TAG,"")) I 'TAGIEN D ; for new tag, create a new LABEL node,
122 . L +@GPREF@(0):10
123 . E Q
124 . S X=$G(@GPREF@(0)) S:X="" X="^2006.682A^0^0"
125 . S TAGIEN=$P(X,U,3)
126 . F S TAGIEN=TAGIEN+1 I '$D(@GPREF@(TAGIEN)) Q
127 . S T=$P(X,U,4)+1,$P(X,U,3)=TAGIEN,$P(X,U,4)=T
128 . S @GPREF@(0)=X,@GPREF@("B",TAG,TAGIEN)=""
129 . L -@GPREF@(0)
130 . S $P(@GPREF@(TAGIEN,0),U)=TAG
131 I TAG'="*DUM"!((TAG="*DUM")&'DUMMY) D
132 . S TAGCTRL=$G(@GPREF@(TAGIEN,1,0)) K @GPREF@(TAGIEN,1),^(2) ; init Data & Keys
133 . S $P(TAGCTRL,U,2)=2006.6821,$P(TAGCTRL,U,3,4)=0_U_0
134 . S @GPREF@(TAGIEN,1,0)=TAGCTRL
135 . S TAGCT=0,LBLCT=LBLCT+1
136 I TAG="*DUM" S TAGCT=+$P(@GPREF@(TAGIEN,1,0),U,3),LBLCT=LBLCT-'DUMMY,DUMMY=1 ; don't count dummy label
137 S NEWTAG=0,STUFF=1
138 Q
139 ;
140TAGS ; return list of tags stored
141 ; don't report *DUM tags
142 N TAG,CT,OTAG,TAGCT,TAGIEN
143 S TAG=0,CT=0,TAGCT=0
144 F S TAG=$O(@GPREF@("B",TAG)) Q:TAG="" S TAGIEN=$O(^(TAG,"")) I TAG'="*DUM" D
145 . I PDIV Q:PDIV'=+TAG S OTAG=$P(TAG,"*DIV*",2,99)
146 . E S OTAG=TAG
147 . S CT=CT+1,@MAGGRY@(CT)=OTAG,TAGCT=TAGCT+1
148 . I $D(@GPREF@(TAGIEN,2)) S KEYCT=0 D
149 . . F S KEYCT=$O(@GPREF@(TAGIEN,2,KEYCT)) Q:'KEYCT S X=^(KEYCT,0),CT=CT+1,@MAGGRY@(CT)=X
150 I TAGCT S REPLY=1_"~"_TAGCT_" tag"_$S(TAGCT-1:"s",1:"")_" returned."
151 E S REPLY="0~No data found."
152TAGSZ S @MAGGRY@(0)=CT_U_REPLY
153 Q
154 ;
155SYSUSER(X) ; get System user DUZ value
156 S X=.5 ; =Postmaster
157 Q:$Q X Q
158 ;
159USER(DUZ) ; get user name, initials & vrad user type
160 N RSL,X S RSL=DUZ
161 I DUZ=$$SYSUSER() S RSL="sysAdmin^SYS^9"
162 E I DUZ D
163 . S RSL=$$USERINF^MAGJUTL3(DUZ,".01;1")
164 . F X="S","R","T" I $D(^VA(200,"ARC",X,DUZ)) Q
165 . I S X=$S(X="S":3,X="R":2,X="T":1,1:0)
166 . E S X=0
167 . S RSL=RSL_U_X
168 Q:$Q RSL Q
169 ;
170USERS ; return list of users stored -- Sort: System User/Radiologists/Non-Rists
171 ; DUZ ^ FULL NAME ^ INITIALS ^ USER TYPE
172 N CT,IEN,INIT,NAME,TOUT,USERTYP
173 S IEN=0,CT=0
174 F S IEN=$O(^MAG(2006.68,IEN)) Q:'IEN S X=^(IEN,0) D
175 . S USERDUZ=$P(X,U,2)
176 . S X=$$USER(USERDUZ),NAME=$P(X,U),INIT=$P(X,U,2),USERTYP=$P(X,U,3)
177 . I NAME="" S NAME="~"
178 . S TOUT(-USERTYP,NAME,USERDUZ)=INIT
179 S USERTYP="" F S USERTYP=$O(TOUT(USERTYP)) Q:USERTYP="" S NAME="" D
180 . F S NAME=$O(TOUT(USERTYP,NAME)) Q:NAME="" S USERDUZ="" D
181 . . F S USERDUZ=$O(TOUT(USERTYP,NAME,USERDUZ)) Q:'USERDUZ D
182 . . . S CT=CT+1,@MAGGRY@(CT)=USERDUZ_U_NAME_U_TOUT(USERTYP,NAME,USERDUZ)_U_-USERTYP
183 I CT S REPLY=1_"~"_CT_" user"_$S(CT-1:"s",1:"")_" returned."
184 E S REPLY="0~No data found."
185USERSZ ;
186 S @MAGGRY@(0)=CT_U_REPLY
187 Q
188 ;
189PRFDATA ; RETURN data stored for input Labels
190 N TAGS,IDATA,CT,NTAGS,LINCT,OTAG,TAG,TAGCT,TAGIEN,X
191 S IDATA="",CT=0,NTAGS=0,LINCT=0
192 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D
193 . I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div
194 . S TAGS(TAG)=""
195 S TAG=0
196 F S TAG=$O(TAGS(TAG)) Q:TAG="" S TAGIEN=$O(@GPREF@("B",TAG,"")),NTAGS=NTAGS+1 D
197 . S OTAG=TAG I PDIV S OTAG=$P(TAG,"*DIV*",2,99)
198 . S CT=CT+1,@MAGGRY@(CT)="*LABEL",CT=CT+1,@MAGGRY@(CT)=OTAG I TAGIEN S TAGCT=0 D
199 . . F S TAGCT=$O(@GPREF@(TAGIEN,1,TAGCT)) Q:'TAGCT S X=^(TAGCT,0),CT=CT+1,@MAGGRY@(CT)=X,LINCT=LINCT+1
200 . S CT=CT+1,@MAGGRY@(CT)="*END"
201 I CT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" returned for "_NTAGS_" tags."
202 E S REPLY="0~No data found."
203PRFZ S @MAGGRY@(0)=CT_U_REPLY
204 Q
205 ;
206TAGDEL ; Delete tags and assoc data
207 I READONLY S REPLY="0~No tags deleted; read-only access permitted." G TAGDELZ
208 N TAG,CT,IDATA,TAG,TAGIEN,ERR
209 S TAG=0,CT=0,IDATA="",ERR=""
210 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D
211 . I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div
212 . S TAGIEN=$O(@GPREF@("B",TAG,"")) I TAGIEN D
213 . . L +@GPREF@(0):10
214 . . E S ERR="0~Unable to perform Delete operation." Q
215 . . K @GPREF@(TAGIEN),@GPREF@("B",TAG)
216 . . S X=$G(@GPREF@(0),"^2006.682A^0^0") S T=+$P(X,U,4) S:T T=T-1 S $P(X,U,4)=T,^(0)=X
217 . . L -@GPREF@(0)
218 . . S CT=CT+1
219 I CT S REPLY=1_"~"_CT_" label"_$S(CT-1:"s",1:"")_" deleted."
220 E S REPLY=$S(ERR]"":ERR,1:"0~No label data found.")
221TAGDELZ S @MAGGRY@(0)=0_U_REPLY
222 Q
223 ;
224END ;
Note: See TracBrowser for help on using the repository browser.