| 1 | MAGJPRF1 ;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
|
|---|
| 19 | ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
|
|---|
| 20 | D @^%ZOSF("ERRTN")
|
|---|
| 21 | Q:$Q 1 Q
|
|---|
| 22 | ;
|
|---|
| 23 | RPCIN(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."
|
|---|
| 76 | RPCINZ S @MAGGRY@(0)=0_U_REPLY
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
| 79 | GETPRIEN(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 | ;
|
|---|
| 96 | SAVE ; 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
|
|---|
| 113 | SAVEZ 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
|
|---|
| 118 | TAGINIT(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 | ;
|
|---|
| 140 | TAGS ; 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."
|
|---|
| 152 | TAGSZ S @MAGGRY@(0)=CT_U_REPLY
|
|---|
| 153 | Q
|
|---|
| 154 | ;
|
|---|
| 155 | SYSUSER(X) ; get System user DUZ value
|
|---|
| 156 | S X=.5 ; =Postmaster
|
|---|
| 157 | Q:$Q X Q
|
|---|
| 158 | ;
|
|---|
| 159 | USER(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 | ;
|
|---|
| 170 | USERS ; 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."
|
|---|
| 185 | USERSZ ;
|
|---|
| 186 | S @MAGGRY@(0)=CT_U_REPLY
|
|---|
| 187 | Q
|
|---|
| 188 | ;
|
|---|
| 189 | PRFDATA ; 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."
|
|---|
| 203 | PRFZ S @MAGGRY@(0)=CT_U_REPLY
|
|---|
| 204 | Q
|
|---|
| 205 | ;
|
|---|
| 206 | TAGDEL ; 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.")
|
|---|
| 221 | TAGDELZ S @MAGGRY@(0)=0_U_REPLY
|
|---|
| 222 | Q
|
|---|
| 223 | ;
|
|---|
| 224 | END ;
|
|---|
