BEHOORSM.m

BEHOORSM ;IHS/MSC/MGH - SiGN or SYmptom List Manager Routine ;27-Sep-2013 15:26;DU

 ;;1.1;BEH COMPONENTS;**011006**;Sep 18, 2007

 ;;

EN(ICDFLAG) ; -- main entry point for OR SNOMED SELECT

 S ICDFLAG=$G(ICDFLAG,0)

 D EN^VALM("OR SNOMED SELECT")

 Q

 ;

SELECT ; EP - Do the Selection

 K DIR

 N X

 S DIR(0)="N^"_VALMBG_":"_VALMLST_":0"

 D ^DIR

 I $G(X)["^"  S Y=99999999  G QUIT^BEHOORSY     ; Trick to exit

 S WHICHONE=+$G(Y)

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="SNOMED Selection"

 Q

 ;

INIT ; -- init variables and list array

 S (LINE,NUM)=0

 K DUPS

 F  S NUM=$O(VARS(NUM))  Q:NUM<1  D

 . ; If ICDFLAG, then SNOMED must also have an ICD CODE associated with it

 . Q:ICDFLAG&($L($G(VARS(NUM,"ICD",1,"COD")))<1&($L($G(VARS(NUM,"10D",1,"COD")))<1))

 . ;

 . ; S SNOMED=$G(VARS(NUM,"FSN","DSC"))

 . ; S SNOMEDSC=$G(VARS(NUM,"FSN","TRM"))

 . S SNOMED=$G(VARS(NUM,"PRB","DSC"))

 . S SNOMEDSC=$G(VARS(NUM,"PRB","TRM"))

 . S ICDCODE=$G(VARS(NUM,"ICD",1,"COD"))

 . ;

 . ; Q:$D(DUPS(SNOMED))   ; Don't list if Duplicate SNOMED code

 . ;

 . ; S DUPS(SNOMED)=""

 . S LINE=LINE+1

 . ;

 . S LINEVAR=""

 . S LINEVAR=$$SETFLD^VALM1($J(LINE,2)_") "_SNOMED,LINEVAR,"SNOMED")

 . S LINEVAR=$$SETFLD^VALM1(SNOMEDSC,LINEVAR,"SNOMED DESCRIPTION")

 . ;

 . D SET^VALM10(LINE,LINEVAR)

 . S SNOMED(LINE)=SNOMED_"^"_SNOMEDSC_"^"_ICDCODE

 S VALMCNT=LINE

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

BEHOORSM  ;IHS/MSC/MGH - SiGN or SYmptom List Manager Routine ;27-Sep-2013 15:26;DU

 +1       ;;1.1;BEH COMPONENTS;**011006**;Sep 18, 2007

 +2       ;;

EN(ICDFLAG) ; -- main entry point for OR SNOMED SELECT

 +1        SET ICDFLAG=$GET(ICDFLAG,0)

 +2        DO EN^VALM("OR SNOMED SELECT")

 +3        QUIT 

 +4       ;

SELECT    ; EP - Do the Selection

 +1        KILL DIR

 +2        NEW X

 +3        SET DIR(0)="N^"_VALMBG_":"_VALMLST_":0"

 +4        DO ^DIR

 +5       ; Trick to exit

           IF $GET(X)["^"

               SET Y=99999999

               GOTO QUIT^BEHOORSY

 +6        SET WHICHONE=+$GET(Y)

 +7        QUIT 

 +8       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="SNOMED Selection"

 +2        QUIT 

 +3       ;

INIT      ; -- init variables and list array

 +1        SET (LINE,NUM)=0

 +2        KILL DUPS

 +3        FOR 

               SET NUM=$ORDER(VARS(NUM))

               IF NUM<1

                   QUIT 

               Begin DoDot:1

 +4       ; If ICDFLAG, then SNOMED must also have an ICD CODE associated with it

 +5                IF ICDFLAG&($LENGTH($GET(VARS(NUM,"ICD",1,"COD")))<1&($LENGTH($GET(VARS(NUM,"10D",1,"COD")))<1))

                       QUIT 

 +6       ;

 +7       ; S SNOMED=$G(VARS(NUM,"FSN","DSC"))

 +8       ; S SNOMEDSC=$G(VARS(NUM,"FSN","TRM"))

 +9                SET SNOMED=$GET(VARS(NUM,"PRB","DSC"))

 +10               SET SNOMEDSC=$GET(VARS(NUM,"PRB","TRM"))

 +11               SET ICDCODE=$GET(VARS(NUM,"ICD",1,"COD"))

 +12      ;

 +13      ; Q:$D(DUPS(SNOMED))   ; Don't list if Duplicate SNOMED code

 +14      ;

 +15      ; S DUPS(SNOMED)=""

 +16               SET LINE=LINE+1

 +17      ;

 +18               SET LINEVAR=""

 +19               SET LINEVAR=$$SETFLD^VALM1($JUSTIFY(LINE,2)_") "_SNOMED,LINEVAR,"SNOMED")

 +20               SET LINEVAR=$$SETFLD^VALM1(SNOMEDSC,LINEVAR,"SNOMED DESCRIPTION")

 +21      ;

 +22               DO SET^VALM10(LINE,LINEVAR)

 +23               SET SNOMED(LINE)=SNOMED_"^"_SNOMEDSC_"^"_ICDCODE

               End DoDot:1

 +24       SET VALMCNT=LINE

 +25       QUIT 

 +26      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT