225 lines
9.5 KiB
Mathematica
225 lines
9.5 KiB
Mathematica
|
MAGJPRF1 ;WIRMFO/JHC VistaRad RPCs-User Prefs ; 05 May 2004 10:05 AM
|
||
|
|
;;3.0;IMAGING;**18**;Mar 07, 2006
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;; | 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. |
|
||
|
|
;; +---------------------------------------------------------------+
|
||
|
|
;;
|
||
|
|
Q
|
||
|
|
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
|
||
|
|
D @^%ZOSF("ERRTN")
|
||
|
|
Q:$Q 1 Q
|
||
|
|
;
|
||
|
|
RPCIN(MAGGRY,PARAMS,DATA) ; RPC: MAGJ USER DATA
|
||
|
|
;PARAMS: TXID ^ SYSUPDAT ^ TXDUZ ^ TXDIV
|
||
|
|
;TXID: Req'd--action to take; see below
|
||
|
|
;TXDUZ: Opt; if input, get data for another user
|
||
|
|
;TXDIV: Opt; if input, get data for another div
|
||
|
|
;SYSUPDAT: Opt; if input, save Sys Default data; Sec Key Req'd
|
||
|
|
; DATA--(opt) input array; depends on TXID; see subs by TXID
|
||
|
|
;Pattern for DATA input & reply is:
|
||
|
|
;*LABEL ; Start for one label
|
||
|
|
;Label_Name ; label name
|
||
|
|
;(1:N lines of XML text follow)
|
||
|
|
;*END ; end for label
|
||
|
|
;*LABEL ; Start for next label (etc.)
|
||
|
|
;Label_Name_2
|
||
|
|
;*KEY ; index keys to follow (KEY data is opt)
|
||
|
|
;KeyNam1=nnn ; 1st key (free-text)
|
||
|
|
;KeyNam2=jjj ; 2nd key (etc.)
|
||
|
|
;*END_KEY ; end of keys
|
||
|
|
; (1:N lines of XML text follow)
|
||
|
|
;*END ; end for label
|
||
|
|
;
|
||
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJPRF1"
|
||
|
|
N GPREF,MAGLST,PREFIEN,REPLY,TXTYPE,PDIV,TXDUZ,TXID,TXDIV,READONLY,SYSUPDAT
|
||
|
|
S TXID=+PARAMS,SYSUPDAT=+$P(PARAMS,U,2),TXDUZ=$P(PARAMS,U,3),TXDIV=+$P(PARAMS,U,4)
|
||
|
|
S MAGLST="MAGJRPC" K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
|
||
|
|
S DIQUIET=1 D DT^DICRW
|
||
|
|
; no updates allowed if read another user's data, or get data for another logon division
|
||
|
|
I 'TXDUZ,(TXDUZ="sysAdmin") S TXDUZ=$$SYSUSER()
|
||
|
|
I 'TXDUZ S TXDUZ=DUZ
|
||
|
|
I 'TXDIV S TXDIV=DUZ(2)
|
||
|
|
S READONLY=(TXDUZ'=DUZ)
|
||
|
|
; I 'READONLY S READONLY=(TXDIV'=DUZ(2)) ; <*> ?? Put this check inside Div-sensitive operations <*>
|
||
|
|
I READONLY,$D(MAGJOB("KEYS","MAGJ SYSTEM USER")),SYSUPDAT,(TXDUZ=$$SYSUSER()) S READONLY=0 ; get/update SysDefault data
|
||
|
|
S PREFIEN=$$GETPRIEN(TXDUZ,READONLY)
|
||
|
|
I 'PREFIEN S REPLY="0~Unable to get/update user data ("_$$USER(TXDUZ)_") for MAGJ USER DATA rpc call." G RPCINZ
|
||
|
|
; set this level based on the TXID
|
||
|
|
S TXID=+$G(TXID)
|
||
|
|
;
|
||
|
|
S TXTYPE="VR-WS",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV=""
|
||
|
|
; workstation settings, user preferences, etc.
|
||
|
|
I TXID=1 G:'READONLY SAVE S REPLY="Access for updating preferences denied." G RPCINZ ; Store prefs by label
|
||
|
|
I TXID=2 G TAGS ; Get Labels w/ assoc. Keys
|
||
|
|
I TXID=3 G PRFDATA ; Get pref data for labels
|
||
|
|
I TXID=4 G:'READONLY TAGDEL S REPLY="Access for deleting preferences denied." G RPCINZ ; Delete labels
|
||
|
|
I TXID=6 G USERS ; Get list of vrad users, including SysAdmin
|
||
|
|
;
|
||
|
|
S TXTYPE="VR-HP",GPREF=$NA(^MAG(2006.68,PREFIEN,TXTYPE)),PDIV="" ; Hanging Protocols
|
||
|
|
I TXID=11 G:'READONLY SAVE S REPLY="Access for updating Hanging Protocols denied." G RPCINZ ; Store HP by label
|
||
|
|
I TXID=12 G TAGS ; Get HP Labels
|
||
|
|
I TXID=13 G PRFDATA ; Get data for HP labels
|
||
|
|
I TXID=14 G:'READONLY TAGDEL S REPLY="Access for deleting Hanging Protocol denied." G RPCINZ ; Delete HP labels
|
||
|
|
;
|
||
|
|
E S REPLY="0~Invalid transaction (TX="_TXID_") requested by MAGJ USER DATA rpc call."
|
||
|
|
RPCINZ S @MAGGRY@(0)=0_U_REPLY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
GETPRIEN(DUZ,READONLY) ; Lookup/create User Pref entry for input DUZ
|
||
|
|
; READONLY: True for lookup-only (no create)
|
||
|
|
N T,X,PREFIEN
|
||
|
|
S PREFIEN=$O(^MAG(2006.68,"AC",+DUZ,"")) I 'PREFIEN,'READONLY D
|
||
|
|
. L +^MAG(2006.68,0):10
|
||
|
|
. E Q
|
||
|
|
. S X=$G(^MAG(2006.68,0))
|
||
|
|
. S PREFIEN=+$P(X,U,3)
|
||
|
|
. F S PREFIEN=PREFIEN+1 I '$D(^MAG(2006.68,PREFIEN)) Q
|
||
|
|
. S T=$P(X,U,4)+1,$P(X,U,3)=PREFIEN,$P(X,U,4)=T
|
||
|
|
. S ^MAG(2006.68,0)=X
|
||
|
|
. S T=$$USER(+DUZ),^MAG(2006.68,PREFIEN,0)=$P(T,U)_U_+DUZ_U_$P(T,U,3)
|
||
|
|
. S ^MAG(2006.68,"B",$P(T,U),PREFIEN)=""
|
||
|
|
. S ^MAG(2006.68,"AC",+DUZ,PREFIEN)=""
|
||
|
|
. L -^MAG(2006.68,0)
|
||
|
|
Q PREFIEN
|
||
|
|
;
|
||
|
|
SAVE ; Save User Pref data by Label
|
||
|
|
N NEWTAG,STUFF,LINCT,LBLCT,DUMMY,KEYS
|
||
|
|
S NEWTAG=0,STUFF=0,LINCT=0,LBLCT=0,DUMMY=0,KEYS=0
|
||
|
|
S IDATA=""
|
||
|
|
F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S LINE=DATA(IDATA) I LINE]"" D
|
||
|
|
. I LINE="*LABEL" S NEWTAG=1,STUFF=0 Q
|
||
|
|
. I LINE="*END" S NEWTAG=0,STUFF=0 Q
|
||
|
|
. I NEWTAG S TAG=LINE D TAGINIT(TAG) Q ; Init the storage for this tag
|
||
|
|
. I 'STUFF S TAG="*DUM" D TAGINIT(TAG) ; got text line w/out prior label; init dummy tag
|
||
|
|
. S TAGCT=TAGCT+1,@GPREF@(TAGIEN,1,TAGCT,0)=LINE,LINCT=LINCT+1
|
||
|
|
. S $P(@GPREF@(TAGIEN,1,0),U,3,4)=TAGCT_U_TAGCT
|
||
|
|
. I TAG="*DUM" S LINCT=LINCT-1 ; don't count dummy lines/labels
|
||
|
|
. I LINE="*KEY" S KEYS=1
|
||
|
|
. I KEYS D
|
||
|
|
. . S KEYCT=+$P($G(@GPREF@(TAGIEN,2,0)),U,4)+1,^(0)="^2006.6823^"_KEYCT_U_KEYCT
|
||
|
|
. . S @GPREF@(TAGIEN,2,KEYCT,0)=LINE
|
||
|
|
. I LINE="*END_KEY" S KEYS=0
|
||
|
|
SAVEZ I LINCT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" were stored for "_LBLCT_" label"_$S(LBLCT-1:"s.",1:".")
|
||
|
|
E S REPLY="0~No data was stored."
|
||
|
|
S @MAGGRY@(0)=0_U_REPLY
|
||
|
|
I DUMMY ; n/a
|
||
|
|
Q
|
||
|
|
TAGINIT(TAG) ; Init storage space for a tag; inits some vars for SAVE
|
||
|
|
N TAGCTRL
|
||
|
|
I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by division
|
||
|
|
S TAGIEN=$O(@GPREF@("B",TAG,"")) I 'TAGIEN D ; for new tag, create a new LABEL node,
|
||
|
|
. L +@GPREF@(0):10
|
||
|
|
. E Q
|
||
|
|
. S X=$G(@GPREF@(0)) S:X="" X="^2006.682A^0^0"
|
||
|
|
. S TAGIEN=$P(X,U,3)
|
||
|
|
. F S TAGIEN=TAGIEN+1 I '$D(@GPREF@(TAGIEN)) Q
|
||
|
|
. S T=$P(X,U,4)+1,$P(X,U,3)=TAGIEN,$P(X,U,4)=T
|
||
|
|
. S @GPREF@(0)=X,@GPREF@("B",TAG,TAGIEN)=""
|
||
|
|
. L -@GPREF@(0)
|
||
|
|
. S $P(@GPREF@(TAGIEN,0),U)=TAG
|
||
|
|
I TAG'="*DUM"!((TAG="*DUM")&'DUMMY) D
|
||
|
|
. S TAGCTRL=$G(@GPREF@(TAGIEN,1,0)) K @GPREF@(TAGIEN,1),^(2) ; init Data & Keys
|
||
|
|
. S $P(TAGCTRL,U,2)=2006.6821,$P(TAGCTRL,U,3,4)=0_U_0
|
||
|
|
. S @GPREF@(TAGIEN,1,0)=TAGCTRL
|
||
|
|
. S TAGCT=0,LBLCT=LBLCT+1
|
||
|
|
I TAG="*DUM" S TAGCT=+$P(@GPREF@(TAGIEN,1,0),U,3),LBLCT=LBLCT-'DUMMY,DUMMY=1 ; don't count dummy label
|
||
|
|
S NEWTAG=0,STUFF=1
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TAGS ; return list of tags stored
|
||
|
|
; don't report *DUM tags
|
||
|
|
N TAG,CT,OTAG,TAGCT,TAGIEN
|
||
|
|
S TAG=0,CT=0,TAGCT=0
|
||
|
|
F S TAG=$O(@GPREF@("B",TAG)) Q:TAG="" S TAGIEN=$O(^(TAG,"")) I TAG'="*DUM" D
|
||
|
|
. I PDIV Q:PDIV'=+TAG S OTAG=$P(TAG,"*DIV*",2,99)
|
||
|
|
. E S OTAG=TAG
|
||
|
|
. S CT=CT+1,@MAGGRY@(CT)=OTAG,TAGCT=TAGCT+1
|
||
|
|
. I $D(@GPREF@(TAGIEN,2)) S KEYCT=0 D
|
||
|
|
. . F S KEYCT=$O(@GPREF@(TAGIEN,2,KEYCT)) Q:'KEYCT S X=^(KEYCT,0),CT=CT+1,@MAGGRY@(CT)=X
|
||
|
|
I TAGCT S REPLY=1_"~"_TAGCT_" tag"_$S(TAGCT-1:"s",1:"")_" returned."
|
||
|
|
E S REPLY="0~No data found."
|
||
|
|
TAGSZ S @MAGGRY@(0)=CT_U_REPLY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
SYSUSER(X) ; get System user DUZ value
|
||
|
|
S X=.5 ; =Postmaster
|
||
|
|
Q:$Q X Q
|
||
|
|
;
|
||
|
|
USER(DUZ) ; get user name, initials & vrad user type
|
||
|
|
N RSL,X S RSL=DUZ
|
||
|
|
I DUZ=$$SYSUSER() S RSL="sysAdmin^SYS^9"
|
||
|
|
E I DUZ D
|
||
|
|
. S RSL=$$USERINF^MAGJUTL3(DUZ,".01;1")
|
||
|
|
. F X="S","R","T" I $D(^VA(200,"ARC",X,DUZ)) Q
|
||
|
|
. I S X=$S(X="S":3,X="R":2,X="T":1,1:0)
|
||
|
|
. E S X=0
|
||
|
|
. S RSL=RSL_U_X
|
||
|
|
Q:$Q RSL Q
|
||
|
|
;
|
||
|
|
USERS ; return list of users stored -- Sort: System User/Radiologists/Non-Rists
|
||
|
|
; DUZ ^ FULL NAME ^ INITIALS ^ USER TYPE
|
||
|
|
N CT,IEN,INIT,NAME,TOUT,USERTYP
|
||
|
|
S IEN=0,CT=0
|
||
|
|
F S IEN=$O(^MAG(2006.68,IEN)) Q:'IEN S X=^(IEN,0) D
|
||
|
|
. S USERDUZ=$P(X,U,2)
|
||
|
|
. S X=$$USER(USERDUZ),NAME=$P(X,U),INIT=$P(X,U,2),USERTYP=$P(X,U,3)
|
||
|
|
. I NAME="" S NAME="~"
|
||
|
|
. S TOUT(-USERTYP,NAME,USERDUZ)=INIT
|
||
|
|
S USERTYP="" F S USERTYP=$O(TOUT(USERTYP)) Q:USERTYP="" S NAME="" D
|
||
|
|
. F S NAME=$O(TOUT(USERTYP,NAME)) Q:NAME="" S USERDUZ="" D
|
||
|
|
. . F S USERDUZ=$O(TOUT(USERTYP,NAME,USERDUZ)) Q:'USERDUZ D
|
||
|
|
. . . S CT=CT+1,@MAGGRY@(CT)=USERDUZ_U_NAME_U_TOUT(USERTYP,NAME,USERDUZ)_U_-USERTYP
|
||
|
|
I CT S REPLY=1_"~"_CT_" user"_$S(CT-1:"s",1:"")_" returned."
|
||
|
|
E S REPLY="0~No data found."
|
||
|
|
USERSZ ;
|
||
|
|
S @MAGGRY@(0)=CT_U_REPLY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
PRFDATA ; RETURN data stored for input Labels
|
||
|
|
N TAGS,IDATA,CT,NTAGS,LINCT,OTAG,TAG,TAGCT,TAGIEN,X
|
||
|
|
S IDATA="",CT=0,NTAGS=0,LINCT=0
|
||
|
|
F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D
|
||
|
|
. I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div
|
||
|
|
. S TAGS(TAG)=""
|
||
|
|
S TAG=0
|
||
|
|
F S TAG=$O(TAGS(TAG)) Q:TAG="" S TAGIEN=$O(@GPREF@("B",TAG,"")),NTAGS=NTAGS+1 D
|
||
|
|
. S OTAG=TAG I PDIV S OTAG=$P(TAG,"*DIV*",2,99)
|
||
|
|
. S CT=CT+1,@MAGGRY@(CT)="*LABEL",CT=CT+1,@MAGGRY@(CT)=OTAG I TAGIEN S TAGCT=0 D
|
||
|
|
. . F S TAGCT=$O(@GPREF@(TAGIEN,1,TAGCT)) Q:'TAGCT S X=^(TAGCT,0),CT=CT+1,@MAGGRY@(CT)=X,LINCT=LINCT+1
|
||
|
|
. S CT=CT+1,@MAGGRY@(CT)="*END"
|
||
|
|
I CT S REPLY=1_"~"_LINCT_" Text line"_$S(LINCT-1:"s",1:"")_" returned for "_NTAGS_" tags."
|
||
|
|
E S REPLY="0~No data found."
|
||
|
|
PRFZ S @MAGGRY@(0)=CT_U_REPLY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
TAGDEL ; Delete tags and assoc data
|
||
|
|
I READONLY S REPLY="0~No tags deleted; read-only access permitted." G TAGDELZ
|
||
|
|
N TAG,CT,IDATA,TAG,TAGIEN,ERR
|
||
|
|
S TAG=0,CT=0,IDATA="",ERR=""
|
||
|
|
F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S TAG=DATA(IDATA) I TAG]"" D
|
||
|
|
. I PDIV,(TAG'="*DUM") S TAG=PDIV_"*DIV*"_TAG ; tags tracked by div
|
||
|
|
. S TAGIEN=$O(@GPREF@("B",TAG,"")) I TAGIEN D
|
||
|
|
. . L +@GPREF@(0):10
|
||
|
|
. . E S ERR="0~Unable to perform Delete operation." Q
|
||
|
|
. . K @GPREF@(TAGIEN),@GPREF@("B",TAG)
|
||
|
|
. . 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
|
||
|
|
. . L -@GPREF@(0)
|
||
|
|
. . S CT=CT+1
|
||
|
|
I CT S REPLY=1_"~"_CT_" label"_$S(CT-1:"s",1:"")_" deleted."
|
||
|
|
E S REPLY=$S(ERR]"":ERR,1:"0~No label data found.")
|
||
|
|
TAGDELZ S @MAGGRY@(0)=0_U_REPLY
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
END ;
|