BLRSM.m

BLRSM ;IHS/MSC/MKK - IHS Lab SiGN or SYmptom List Manager Routine ; 10-Mar-2015 09:14 ; MKK

 ;;5.2;LAB SERVICE;**1033,1034**;NOV 1, 1997;Build 88

 ;; ;

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

 S ICDFLAG=$G(ICDFLAG,0)

 D EN^VALM("BLR SNOMED SELECT")

 Q

 ;

SELECT ; EP - Do the Selection

 K DIR

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

 D ^DIR

 I $G(X)="^^^"  S Y=99999999  G FATALERR^BLRSGNSY     ; Trick to exit

 S WHICHONE=+$G(Y)

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)=$G(^TMP("BLR SNOMED GET",$J,"HDR"))

 ; S VALMHDR(2)="This is the second line"

 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")

 . S LINEVAR=$$SETFLD^VALM1(ICDCODE,LINEVAR,"ICD")    ; IHS/MSC/MKK - LR*5.2*1034

 . ;

 . 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

BLRSM     ;IHS/MSC/MKK - IHS Lab SiGN or SYmptom List Manager Routine ; 10-Mar-2015 09:14 ; MKK

 +1       ;;5.2;LAB SERVICE;**1033,1034**;NOV 1, 1997;Build 88

 +2       ;; ;

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

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

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

 +3        QUIT 

 +4       ;

SELECT    ; EP - Do the Selection

 +1        KILL DIR

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

 +3        DO ^DIR

 +4       ; Trick to exit

           IF $GET(X)="^^^"

               SET Y=99999999

               GOTO FATALERR^BLRSGNSY

 +5        SET WHICHONE=+$GET(Y)

 +6        QUIT 

 +7       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$GET(^TMP("BLR SNOMED GET",$JOB,"HDR"))

 +2       ; S VALMHDR(2)="This is the second line"

 +3        QUIT 

 +4       ;

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      ; IHS/MSC/MKK - LR*5.2*1034

                   SET LINEVAR=$$SETFLD^VALM1(ICDCODE,LINEVAR,"ICD")

 +22      ;

 +23               DO SET^VALM10(LINE,LINEVAR)

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

               End DoDot:1

 +25       SET VALMCNT=LINE

 +26       QUIT 

 +27      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT