Routine: BSTSUPRF

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

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)

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)

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)

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

BSTSUPRF.m