BSTSUPRF ;GDIT/HS/BEE - SNOMED User Preferences - RPC Calls ; 10 Aug 2012 9:24 AM
;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
;
Q
;
SET(DATA,NMID,INPUT) ;EP - BSTS SET USER PREFS
;
;Description
; Saves search preference for a user
;
;Input
; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
; FS - Default Search Type (F-FSN/S-Synonym), default it F
; CNT - Number of records to return (25, 50, 100, 200, ALL), default is 50
; PC - Display Parent Child Info (1-Yes/0-No) - default is No
; AC - Disable Autocomplete
;
;Output
; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
;
;Variables Used
; UID - Unique TMP global subscript.
;
NEW UID,II,DLAYGO,X,Y,DIC,DA,NMIEN,BSTSUP,IENS,ERROR,NMID,FS,CNT,PC,AC
;
;Address blank inputs
S INPUT=$G(INPUT)
S NMID=$G(NMID) S:NMID="" NMID=36
S FS=$P(INPUT,"|")
S CNT=$P(INPUT,"|",2)
S PC=$P(INPUT,"|",3)
S AC=$P(INPUT,"|",4)
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BSTSUPRF",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSUPRF D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S II=0
S @DATA@(0)="T00001RESULT^T00100ERROR_MESSAGE"_$C(30)
;
;Input validation
I '$D(^BSTS(9002318.1,"B",NMID)) S II=II+1,@DATA@(II)="-1^Invalid Namespace ID"_$C(30) G XSET
I CNT'="",CNT'=25,CNT'=50,CNT'=100,CNT'=200,CNT'="ALL" S II=II+1,@DATA@(II)="-1^Invalid Record Count Value"_$C(30) G XSET
I PC'="",PC'=1,PC'=0 S II=II+1,@DATA@(II)="-1^Invalid Display Parents/Children Value"_$C(30) G XSET
I FS'="",FS'="F",FS'="S" S II=II+1,@DATA@(II)="-1^Invalid Search Type"_$C(30) G XSET
I AC'="",AC'=1,AC'=0 S II=II+1,@DATA@(II)="-1^Invalid Disable Auto-complete Value"_$C(30) G XSET
;
;Process resets
I CNT="",PC="",FS="",AC="" D G XSET
. NEW RES
. S RES=$$RESET(NMID)
. S II=II+1,@DATA@(II)=RES_$C(30)
;
;Plug in details
S:FS="" FS="F"
S:CNT="" CNT=50
S:PC="" PC=0
S:AC="" AC=0
;
;Check for existing user entry
I '$D(^BSTS(9002318.7,"B",DUZ)) D
. S DLAYGO=9002318.7,DIC(0)="LX",DIC="^BSTS(9002318.7,",X=DUZ
. K DO,DD D FILE^DICN
S DA(1)=$O(^BSTS(9002318.7,"B",DUZ,"")) I DA(1)="" S II=II+1,@DATA@(II)="-1^Could not file new user entry"_$C(30) G XSET
;
;Check for namespace entry
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) I NMIEN="" S II=II+1,@DATA@(II)="-1^Invalid Namespace ID"_$C(30) G XSET
I '$D(^BSTS(9002318.7,DA(1),1,"B",NMIEN)) D
. S DLAYGO=9002318.71,DIC(0)="LX",DIC="^BSTS(9002318.7,"_DA(1)_",1,",X=NMIEN
. K DO,DD D FILE^DICN
S DA=$O(^BSTS(9002318.7,DA(1),1,"B",NMIEN,"")) I DA="" S II=II+1,@DATA@(II)="-1^Could not add namespace multiple"_$C(30) G XSET
S IENS=$$IENS^DILF(.DA)
;
S BSTSUP(9002318.71,IENS,.02)=FS
S BSTSUP(9002318.71,IENS,.03)=CNT
S BSTSUP(9002318.71,IENS,.04)=PC
S BSTSUP(9002318.71,IENS,.05)=AC
D FILE^DIE("","BSTSUP","ERROR")
I $D(ERROR) S II=II+1,@DATA@(II)="-1^Could not file entry"_$C(30) G XSET
;
;Log success
S II=II+1,@DATA@(II)="1^"_$C(30)
;
XSET S II=II+1,@DATA@(II)=$C(31)
;
Q
;
GET(DATA,NMID) ;EP - BSTS GET USER PREFS
;
;Description
; Retrieves search preference for a user
;
;Input
; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
;
;Output
; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
;
;Variables Used
; UID - Unique TMP global subscript.
;
;Address blank inputs
S NMID=$G(NMID) S:NMID="" NMID=36
;
N UID,II,DA,NMIEN,IENS,NIEN,PC,CNT,FS,DIEN,AC
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BSTSUPRF",UID))
K @DATA
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BSTSUPRF D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S II=0
S @DATA@(0)="T00100SETTINGS"_$C(30)
;
;Check for existing user entry
S DIEN=$O(^BSTS(9002318.7,"B",DUZ,"")) I DIEN="" S II=II+1,@DATA@(II)="|||"_$C(30) G XGET
;
;Check for namespace entry
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) I NMIEN="" S II=II+1,@DATA@(II)="|||"_$C(30) G XGET
S NIEN=$O(^BSTS(9002318.7,DIEN,1,"B",NMIEN,"")) I NIEN="" S II=II+1,@DATA@(II)="|||"_$C(30) G XGET
;
;Retrieve entry
S DA(1)=DIEN,DA=NIEN
S IENS=$$IENS^DILF(.DA)
S FS=$$GET1^DIQ(9002318.71,IENS,.02,"I")
S CNT=$$GET1^DIQ(9002318.71,IENS,.03,"I")
S PC=$$GET1^DIQ(9002318.71,IENS,.04,"I")
S AC=$$GET1^DIQ(9002318.71,IENS,.05,"I")
S II=II+1,@DATA@(II)=FS_"|"_CNT_"|"_PC_"|"_AC_$C(30)
;
XGET S II=II+1,@DATA@(II)=$C(31)
;
Q
;
RESET(NMID) ;Reset user settings
;
;Description
; Resets search preference for a user
;
;Input
; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
;
;Output
; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
;
;Variables Used
; UID - Unique TMP global subscript.
;
;Address blank inputs
S NMID=$G(NMID) S:NMID="" NMID=36
;
N UID,II,DA,NMIEN,DIEN,DIK,CIEN
;
;Input validation
I '$D(^BSTS(9002318.1,"B",NMID)) Q "-1^Invalid Namespace ID"
;
;Check for existing user entry
S DIEN=$O(^BSTS(9002318.7,"B",DUZ,"")) I DIEN="" Q "1^"
;
;Check for namespace entry
S NMIEN=$O(^BSTS(9002318.1,"B",NMID,"")) I NMIEN="" Q "-1^Invalid Namespace ID"
S CIEN=$O(^BSTS(9002318.7,DIEN,1,"B",NMIEN,"")) I CIEN="" Q "1^"
;
;Remove entry
S DIK="^BSTS(9002318.7,"_DIEN_",1,",DA(1)=DIEN,DA=CIEN
D ^DIK
;
Q "1^"
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
BSTSUPRF ;GDIT/HS/BEE - SNOMED User Preferences - RPC Calls ; 10 Aug 2012 9:24 AM
+1 ;;2.0;IHS STANDARD TERMINOLOGY;;Dec 01, 2016;Build 62
+2 ;
+3 QUIT
+4 ;
SET(DATA,NMID,INPUT) ;EP - BSTS SET USER PREFS
+1 ;
+2 ;Description
+3 ; Saves search preference for a user
+4 ;
+5 ;Input
+6 ; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
+7 ; FS - Default Search Type (F-FSN/S-Synonym), default it F
+8 ; CNT - Number of records to return (25, 50, 100, 200, ALL), default is 50
+9 ; PC - Display Parent Child Info (1-Yes/0-No) - default is No
+10 ; AC - Disable Autocomplete
+11 ;
+12 ;Output
+13 ; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
+14 ;
+15 ;Variables Used
+16 ; UID - Unique TMP global subscript.
+17 ;
+18 NEW UID,II,DLAYGO,X,Y,DIC,DA,NMIEN,BSTSUP,IENS,ERROR,NMID,FS,CNT,PC,AC
+19 ;
+20 ;Address blank inputs
+21 SET INPUT=$GET(INPUT)
+22 SET NMID=$GET(NMID)
IF NMID=""
SET NMID=36
+23 SET FS=$PIECE(INPUT,"|")
+24 SET CNT=$PIECE(INPUT,"|",2)
+25 SET PC=$PIECE(INPUT,"|",3)
+26 SET AC=$PIECE(INPUT,"|",4)
+27 ;
+28 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+29 SET DATA=$NAME(^TMP("BSTSUPRF",UID))
+30 KILL @DATA
+31 ;
+32 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSUPRF D UNWIND^%ZTER"
+33 ;
+34 SET II=0
+35 SET @DATA@(0)="T00001RESULT^T00100ERROR_MESSAGE"_$CHAR(30)
+36 ;
+37 ;Input validation
+38 IF '$DATA(^BSTS(9002318.1,"B",NMID))
SET II=II+1
SET @DATA@(II)="-1^Invalid Namespace ID"_$CHAR(30)
GOTO XSET
+39 IF CNT'=""
IF CNT'=25
IF CNT'=50
IF CNT'=100
IF CNT'=200
IF CNT'="ALL"
SET II=II+1
SET @DATA@(II)="-1^Invalid Record Count Value"_$CHAR(30)
GOTO XSET
+40 IF PC'=""
IF PC'=1
IF PC'=0
SET II=II+1
SET @DATA@(II)="-1^Invalid Display Parents/Children Value"_$CHAR(30)
GOTO XSET
+41 IF FS'=""
IF FS'="F"
IF FS'="S"
SET II=II+1
SET @DATA@(II)="-1^Invalid Search Type"_$CHAR(30)
GOTO XSET
+42 IF AC'=""
IF AC'=1
IF AC'=0
SET II=II+1
SET @DATA@(II)="-1^Invalid Disable Auto-complete Value"_$CHAR(30)
GOTO XSET
+43 ;
+44 ;Process resets
+45 IF CNT=""
IF PC=""
IF FS=""
IF AC=""
Begin DoDot:1
+46 NEW RES
+47 SET RES=$$RESET(NMID)
+48 SET II=II+1
SET @DATA@(II)=RES_$CHAR(30)
End DoDot:1
GOTO XSET
+49 ;
+50 ;Plug in details
+51 IF FS=""
SET FS="F"
+52 IF CNT=""
SET CNT=50
+53 IF PC=""
SET PC=0
+54 IF AC=""
SET AC=0
+55 ;
+56 ;Check for existing user entry
+57 IF '$DATA(^BSTS(9002318.7,"B",DUZ))
Begin DoDot:1
+58 SET DLAYGO=9002318.7
SET DIC(0)="LX"
SET DIC="^BSTS(9002318.7,"
SET X=DUZ
+59 KILL DO,DD
DO FILE^DICN
End DoDot:1
+60 SET DA(1)=$ORDER(^BSTS(9002318.7,"B",DUZ,""))
IF DA(1)=""
SET II=II+1
SET @DATA@(II)="-1^Could not file new user entry"_$CHAR(30)
GOTO XSET
+61 ;
+62 ;Check for namespace entry
+63 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
SET II=II+1
SET @DATA@(II)="-1^Invalid Namespace ID"_$CHAR(30)
GOTO XSET
+64 IF '$DATA(^BSTS(9002318.7,DA(1),1,"B",NMIEN))
Begin DoDot:1
+65 SET DLAYGO=9002318.71
SET DIC(0)="LX"
SET DIC="^BSTS(9002318.7,"_DA(1)_",1,"
SET X=NMIEN
+66 KILL DO,DD
DO FILE^DICN
End DoDot:1
+67 SET DA=$ORDER(^BSTS(9002318.7,DA(1),1,"B",NMIEN,""))
IF DA=""
SET II=II+1
SET @DATA@(II)="-1^Could not add namespace multiple"_$CHAR(30)
GOTO XSET
+68 SET IENS=$$IENS^DILF(.DA)
+69 ;
+70 SET BSTSUP(9002318.71,IENS,.02)=FS
+71 SET BSTSUP(9002318.71,IENS,.03)=CNT
+72 SET BSTSUP(9002318.71,IENS,.04)=PC
+73 SET BSTSUP(9002318.71,IENS,.05)=AC
+74 DO FILE^DIE("","BSTSUP","ERROR")
+75 IF $DATA(ERROR)
SET II=II+1
SET @DATA@(II)="-1^Could not file entry"_$CHAR(30)
GOTO XSET
+76 ;
+77 ;Log success
+78 SET II=II+1
SET @DATA@(II)="1^"_$CHAR(30)
+79 ;
XSET SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 ;
+2 QUIT
+3 ;
GET(DATA,NMID) ;EP - BSTS GET USER PREFS
+1 ;
+2 ;Description
+3 ; Retrieves search preference for a user
+4 ;
+5 ;Input
+6 ; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
+7 ;
+8 ;Output
+9 ; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
+10 ;
+11 ;Variables Used
+12 ; UID - Unique TMP global subscript.
+13 ;
+14 ;Address blank inputs
+15 SET NMID=$GET(NMID)
IF NMID=""
SET NMID=36
+16 ;
+17 NEW UID,II,DA,NMIEN,IENS,NIEN,PC,CNT,FS,DIEN,AC
+18 ;
+19 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+20 SET DATA=$NAME(^TMP("BSTSUPRF",UID))
+21 KILL @DATA
+22 ;
+23 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BSTSUPRF D UNWIND^%ZTER"
+24 ;
+25 SET II=0
+26 SET @DATA@(0)="T00100SETTINGS"_$CHAR(30)
+27 ;
+28 ;Check for existing user entry
+29 SET DIEN=$ORDER(^BSTS(9002318.7,"B",DUZ,""))
IF DIEN=""
SET II=II+1
SET @DATA@(II)="|||"_$CHAR(30)
GOTO XGET
+30 ;
+31 ;Check for namespace entry
+32 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
SET II=II+1
SET @DATA@(II)="|||"_$CHAR(30)
GOTO XGET
+33 SET NIEN=$ORDER(^BSTS(9002318.7,DIEN,1,"B",NMIEN,""))
IF NIEN=""
SET II=II+1
SET @DATA@(II)="|||"_$CHAR(30)
GOTO XGET
+34 ;
+35 ;Retrieve entry
+36 SET DA(1)=DIEN
SET DA=NIEN
+37 SET IENS=$$IENS^DILF(.DA)
+38 SET FS=$$GET1^DIQ(9002318.71,IENS,.02,"I")
+39 SET CNT=$$GET1^DIQ(9002318.71,IENS,.03,"I")
+40 SET PC=$$GET1^DIQ(9002318.71,IENS,.04,"I")
+41 SET AC=$$GET1^DIQ(9002318.71,IENS,.05,"I")
+42 SET II=II+1
SET @DATA@(II)=FS_"|"_CNT_"|"_PC_"|"_AC_$CHAR(30)
+43 ;
XGET SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 ;
+2 QUIT
+3 ;
RESET(NMID) ;Reset user settings
+1 ;
+2 ;Description
+3 ; Resets search preference for a user
+4 ;
+5 ;Input
+6 ; INPUT - NMID - Namespace ID - Default to SNOMED US EXT (#36)
+7 ;
+8 ;Output
+9 ; ^TMP("BSTSUPRF") - Name of global (passed by reference) in which the data is stored.
+10 ;
+11 ;Variables Used
+12 ; UID - Unique TMP global subscript.
+13 ;
+14 ;Address blank inputs
+15 SET NMID=$GET(NMID)
IF NMID=""
SET NMID=36
+16 ;
+17 NEW UID,II,DA,NMIEN,DIEN,DIK,CIEN
+18 ;
+19 ;Input validation
+20 IF '$DATA(^BSTS(9002318.1,"B",NMID))
QUIT "-1^Invalid Namespace ID"
+21 ;
+22 ;Check for existing user entry
+23 SET DIEN=$ORDER(^BSTS(9002318.7,"B",DUZ,""))
IF DIEN=""
QUIT "1^"
+24 ;
+25 ;Check for namespace entry
+26 SET NMIEN=$ORDER(^BSTS(9002318.1,"B",NMID,""))
IF NMIEN=""
QUIT "-1^Invalid Namespace ID"
+27 SET CIEN=$ORDER(^BSTS(9002318.7,DIEN,1,"B",NMIEN,""))
IF CIEN=""
QUIT "1^"
+28 ;
+29 ;Remove entry
+30 SET DIK="^BSTS(9002318.7,"_DIEN_",1,"
SET DA(1)=DIEN
SET DA=CIEN
+31 DO ^DIK
+32 ;
+33 QUIT "1^"
+34 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
