Routine: LA7UTL1B

LA7UTL1B ;VA/HOIFO/BH - Microbilogy Antibiotics & and Output global arragment  ;JUL 06, 2010 3:14 PM

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69,1027**;NOV 01, 1997

 ; Pass back field name of Organism Antibiotic field.  If the Antibiotic

 ; field node is lonnger than six characters it is site specific and

 ; is not returned.

DECODE(VAL) ;

 N STR,MVAL,M1VAL

 S STR=""

 I $E(VAL,1,4)'="2.00" Q ""

 I 'VAL Q ""

 I $L(VAL)>6 Q ""

 S VAL=$P(VAL,".",2)

 I $L(VAL)=3 D

 . S MVAL=+VAL

 . S STR=$P($T(MCODE+MVAL),";;",2)

 I $L(VAL)=4 D

 . S M1VAL=+VAL

 . S STR=$P($T(MCODE1+M1VAL),";;",2)

 Q STR

MCODE ;

 ;;2.001^50~CEFAZOLIN^50.1~CEFAZOLIN INTERP^50.2~CEFAZOLIN SCREEN

 ;;2.002^145~PIPERACILLIN^145.1~PIPERACILLIN INTERP^145.2~PIPERACILLIN SCREEN

 ;;2.003^150~OXACILLIN^150.1~OXACILLIN INTERP^150.2~OXACILLIN SCREEN

 ;;2.004^160~TRIMETHOPRIM^160.1~TRIMETHOPRIM INTERP^160.2~TRIMETHOPRIM SCREEN

MCODE1 ;

 ;;2.0001^5~NEOMYCIN^5.1~NEOMYCIN INTERP^5.2~NEOMYCIN SCREEN

 ;;2.0002^10~BACITRACIN^10.1~BACITRACIN INTERP^10.2~BACITRACIN SCREEN

 ;;2.0003^15~PENICILLIN^15.1~PENICILLIN INTERP^15.2~PENICILLIN SCREEN

 ;;2.0004^20~CLINDAMYCIN^20.1~CLINDAMYCIN INTERP^20.2~CLINDAMYCIN SCREEN

 ;;2.0005^25~METHICILLIN^25.1~METHICILLIN INTERP^25.2~METHICILLIN SCREEN

 ;;2.0006^30~VANCOMYCIN^30.1~VANCOMYCIN INTERP^30.2~VANCOMYCIN SCREEN

 ;;2.0007^35~GENTAMICIN^35.1~GENTAMICIN INTERP^35.2~GENTAMICIN SCREEN

 ;;2.0008^40~CHLORAMPHENICOL^40.1~CHLORAMPHENICOL INTERP^40.2~CHLORAMPHENICOL SCREEN

 ;;2.0009^45~KANAMYCIN^45.1~KANAMYCIN INTERP^45.2~KANAMYCIN SCREEN

;;

 ;;2.0011^55~TETRACYCLINE^55.1~TETRACYCLINE INTERP^55.2~TETRACYCLINE SCREEN

 ;;2.0012^60~AMPICILLIN^60.1~AMPICILLIN INTERP^60.2~AMPICILLIN SCREEN

 ;;2.0013^65~CARBENICILLIN^65.1~CARBENICILLIN INTERP^65.2~CARBENICILLIN SCREEN

 ;;2.0014^70~TOBRAMYCIN^70.1~TOBRAMYCIN INTERP^70.2~TOBRAMYCIN SCREEN

 ;;2.0015^75~TRIMETHAPRIM/SULFAMETHOXAZOLE^75.1~TRIMETHAPRIM/SULFA INTERP^75.2~TRIMETHAPRIM/SULFA SCREEN

 ;;2.0016^80~AMIKACIN^80.1~AMIKACIN INTERP^80.2~AMIKACIN SCREEN

 ;;2.0017^85~CEFAMANDOLE^85.1~CEFAMANDOLE INTERP^85.2~CEFAMANDOLE SCREEN

 ;;2.0018^90~CEFOXITIN^90.1~CEFOXITIN INTERP^90.2~CEFOXITIN SCREEN

 ;;2.0019^110~ERYTHROMYCIN^110.1~ERYTHROMYCIN INTERP^110.2~ERYTHROMYCIN SCREEN

;;

 ;;2.0021^95~CEFOTAXIME^95.1~CEFOTAXIME INTERP^95.2~CEFOTAXIME SCREEN

 ;;2.0022^100~NITROFURANTOIN^100.1~NITROFURANTOIN NTERP^100.2~NITROFURANTOIN SCREEN

 ;;2.0023^105~POLYMYXIN B^105.1~POLYMYXIN B INTERP^105.2~POLYMYXIN B SCREEN

 ;;2.0024^115~RIFAMPIN^115.1~RIFAMPIN INTERP^115.2~RIFAMPIN SCREEN

 ;;2.0025^120~NOVOBIOCIN^120.1~NOVOBIOCIN INTERP^120.2~NOVOBIOCIN SCREEN

 ;;2.0026^125~CEFOPERAZONE^125.1~CEFOPERAZONE INTERP^125.2~CEFOPERAZONE SCREEN

 ;;2.0027^130~MEZLOCILLIN^130.1~MEZLOCILLIN INTERP^130.2~MEZLOCILLIN SCREEN

 ;;2.0028^135~MOXALACTAM^135.1~MOXALACTAM INTERP^135.2~MOXALACTAM SCREEN

 ;;2.0029^140~NETILMICIN^140.1~NETILMICIN INTERP^140.2~NETILMICIN SCREEN

;;

 ;;2.0031^151~SULFISOXAZOLE^151.1~SULFISOXAZOLE INTERP^151.2~SULFISOXAZOLE SCREEN

 ;;2.0032^152~NAFCILLIN^152.1~NAFCILLIN INTERP^152.2~NAFCILLIN SCREEN

 ;;2.0033^153~NALIDIXIC ACID^153.1~NALIDIXIC ACID INTERP^153.2~NALIDIXIC ACID SCREEN

 ;;2.0034^154~CEPHALOTHIN^154.1~CEPHALOTHIN INTERP^154.2~CEPHALOTHIN SCREEN

 ;;2.0035^155~COLISTIN^155.1~COLISTIN INTERP^155.2~COLISTIN SCREEN

 ;;2.0036^156~METRONIDAZOLE^156.1~METRONIDAZOLE INTERP^156.2~METRONIDAZOLE SCREEN

 ;;2.0037^157~CEFUROXIME^157.1~CEFUROXIME INTERP^157.2~CEFUROXIME SCREEN

 ;;2.0038^158~CEFTIZOXIME^158.1~CEFTIZOXIME INTERP^158.2~CEFTIZOXIME SCREEN

 ;;2.0039^159~SPECTINOMYCIN^159.1~SPECTINOMYCIN INTERP^159.2~SPECTINOMYCIN SCREEN

 ;Pass back field name of Mycobacterium Antibiotic field.  If the

 ; Antibiotic field node is lonnger than six characters it is site

 ; specific and is not returned.

DECODEMB(VAL) ;  ---Decode Mycobacterium antibiotics

 N STR,MVAL,M1VAL

 S STR=""

 I $E(VAL,1,4)'="2.00" Q ""

 I 'VAL Q ""

 I $L(VAL)>6 Q ""

 S VAL=$P(VAL,".",2)

 I VAL="001" D

 . S STR="2.001^50~PYRAZINAMIDE"

 I $L(VAL)=4 D

 . S M1VAL=+VAL

 . S STR=$P($T(MBCODE+M1VAL),";;",2)

 Q STR

MBCODE ;

 ;;2.0001^5~STR

 ;;2.0002^10~PAS

 ;;2.0003^15~INH

 ;;2.0004^20~ETH

 ;;2.0005^25~RIF

 ;;2.0006^30~KANAMYCIN

 ;;2.0007^35~CAPREOMYCIN

 ;;2.0008^40~CYCLOSERINE

 ;;2.0009^45~ETHIONAMIDE

;;

 ;;2.0011^55~MIOMYCIN

ARRANGE(LAARRAY,LAARRET) ; Re-set the global to the passed in reference and re-arrage for easier processing.

 F LASET="63.05","63.29","63.3","63.31","63.32","63.33","63.34","63.35","63.351","63.36","63.37","63.372","63.39","63.4","63.43","63.341","63.291","63.371","63.44" D

 . S LACD=""

 . F  S LACD=$O(@LAARRAY@(LASET,LACD)) Q:LACD=""  D

 . . S LACDFLD=""

 . . F  S LACDFLD=$O(@LAARRAY@(LASET,LACD,LACDFLD)) Q:LACDFLD=""  D

 . . . S LACDTYP=""

 . . . F  S LACDTYP=$O(@LAARRAY@(LASET,LACD,LACDFLD,LACDTYP)) Q:LACDTYP=""  D

 . . . . S LADATA=@LAARRAY@(LASET,LACD,LACDFLD,LACDTYP)

 . . . . ;

 . . . . I LASET="63.05" D  Q

 . . . . . S @LAARRET@($P(LACD,",",2),$P(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA Q

 . . . . ;

 . . . . I LASET="63.351" D  Q

 . . . . . S @LAARRET@($P(LACD,",",5),$P(LACD,",",4),"6",$P(LACD,",",3),"1",$P(LACD,",",2),"1",$P(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA Q

 . . . . ;

 . . . . I LASET="63.32" D  Q

 . . . . . S @LAARRET@($P(LACD,",",4),$P(LACD,",",3),3,$P(LACD,",",2),3,$P(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA Q

 . . . . ;

 . . . . I LASET="63.31"!(LASET="63.35")!(LASET="63.372")!(LASET="63.4") D  Q

 . . . . . S LASUB=$S(LASET="63.31":"3",LASET="63.35":"6",LASET="63.372":"9",LASET="63.4":"12",1:"")

 . . . . . I LASUB="" Q

 . . . . . S @LAARRET@($P(LACD,",",4),$P(LACD,",",3),LASUB,$P(LACD,",",2),"1",$P(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA Q

 . . . . ;

 . . . . S LASUB=$S(LASET="63.29":"2",LASET="63.3":"3",LASET="63.33":"4",LASET="63.34":"6",LASET="63.36":"7",LASET="63.37":"9",1:"")

 . . . . I LASUB="" S LASUB=$S(LASET="63.39":"12",LASET="63.43":"17",LASET="63.341":"24",LASET="63.291":"25",LASET="63.371":"15",LASET="63.44":"18",1:"")

 . . . . I LASUB="" Q

 . . . . S @LAARRET@($P(LACD,",",3),$P(LACD,",",2),LASUB,$P(LACD,",",1),0,LACDFLD,LACDTYP)=LADATA

 ; - Kill local array

 K @LAARRAY

LA7UTL1B  ;VA/HOIFO/BH - Microbilogy Antibiotics & and Output global arragment  ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**69,1027**;NOV 01, 1997

 +2       ;

 +3       ; Pass back field name of Organism Antibiotic field.  If the Antibiotic

 +4       ; field node is lonnger than six characters it is site specific and

 +5       ; is not returned.

 +6       ;

DECODE(VAL) ;

 +1        NEW STR,MVAL,M1VAL

 +2        SET STR=""

 +3        IF $EXTRACT(VAL,1,4)'="2.00"

               QUIT ""

 +4        IF 'VAL

               QUIT ""

 +5        IF $LENGTH(VAL)>6

               QUIT ""

 +6        SET VAL=$PIECE(VAL,".",2)

 +7        IF $LENGTH(VAL)=3

               Begin DoDot:1

 +8                SET MVAL=+VAL

 +9                SET STR=$PIECE($TEXT(MCODE+MVAL),";;",2)

               End DoDot:1

 +10       IF $LENGTH(VAL)=4

               Begin DoDot:1

 +11               SET M1VAL=+VAL

 +12               SET STR=$PIECE($TEXT(MCODE1+M1VAL),";;",2)

               End DoDot:1

 +13       QUIT STR

 +14      ;

MCODE     ;

 +1       ;;2.001^50~CEFAZOLIN^50.1~CEFAZOLIN INTERP^50.2~CEFAZOLIN SCREEN

 +2       ;;2.002^145~PIPERACILLIN^145.1~PIPERACILLIN INTERP^145.2~PIPERACILLIN SCREEN

 +3       ;;2.003^150~OXACILLIN^150.1~OXACILLIN INTERP^150.2~OXACILLIN SCREEN

 +4       ;;2.004^160~TRIMETHOPRIM^160.1~TRIMETHOPRIM INTERP^160.2~TRIMETHOPRIM SCREEN

 +5       ;

 +6       ;

MCODE1    ;

 +1       ;;2.0001^5~NEOMYCIN^5.1~NEOMYCIN INTERP^5.2~NEOMYCIN SCREEN

 +2       ;;2.0002^10~BACITRACIN^10.1~BACITRACIN INTERP^10.2~BACITRACIN SCREEN

 +3       ;;2.0003^15~PENICILLIN^15.1~PENICILLIN INTERP^15.2~PENICILLIN SCREEN

 +4       ;;2.0004^20~CLINDAMYCIN^20.1~CLINDAMYCIN INTERP^20.2~CLINDAMYCIN SCREEN

 +5       ;;2.0005^25~METHICILLIN^25.1~METHICILLIN INTERP^25.2~METHICILLIN SCREEN

 +6       ;;2.0006^30~VANCOMYCIN^30.1~VANCOMYCIN INTERP^30.2~VANCOMYCIN SCREEN

 +7       ;;2.0007^35~GENTAMICIN^35.1~GENTAMICIN INTERP^35.2~GENTAMICIN SCREEN

 +8       ;;2.0008^40~CHLORAMPHENICOL^40.1~CHLORAMPHENICOL INTERP^40.2~CHLORAMPHENICOL SCREEN

 +9       ;;2.0009^45~KANAMYCIN^45.1~KANAMYCIN INTERP^45.2~KANAMYCIN SCREEN

 +10      ;;

 +11      ;;2.0011^55~TETRACYCLINE^55.1~TETRACYCLINE INTERP^55.2~TETRACYCLINE SCREEN

 +12      ;;2.0012^60~AMPICILLIN^60.1~AMPICILLIN INTERP^60.2~AMPICILLIN SCREEN

 +13      ;;2.0013^65~CARBENICILLIN^65.1~CARBENICILLIN INTERP^65.2~CARBENICILLIN SCREEN

 +14      ;;2.0014^70~TOBRAMYCIN^70.1~TOBRAMYCIN INTERP^70.2~TOBRAMYCIN SCREEN

 +15      ;;2.0015^75~TRIMETHAPRIM/SULFAMETHOXAZOLE^75.1~TRIMETHAPRIM/SULFA INTERP^75.2~TRIMETHAPRIM/SULFA SCREEN

 +16      ;;2.0016^80~AMIKACIN^80.1~AMIKACIN INTERP^80.2~AMIKACIN SCREEN

 +17      ;;2.0017^85~CEFAMANDOLE^85.1~CEFAMANDOLE INTERP^85.2~CEFAMANDOLE SCREEN

 +18      ;;2.0018^90~CEFOXITIN^90.1~CEFOXITIN INTERP^90.2~CEFOXITIN SCREEN

 +19      ;;2.0019^110~ERYTHROMYCIN^110.1~ERYTHROMYCIN INTERP^110.2~ERYTHROMYCIN SCREEN

 +20      ;;

 +21      ;;2.0021^95~CEFOTAXIME^95.1~CEFOTAXIME INTERP^95.2~CEFOTAXIME SCREEN

 +22      ;;2.0022^100~NITROFURANTOIN^100.1~NITROFURANTOIN NTERP^100.2~NITROFURANTOIN SCREEN

 +23      ;;2.0023^105~POLYMYXIN B^105.1~POLYMYXIN B INTERP^105.2~POLYMYXIN B SCREEN

 +24      ;;2.0024^115~RIFAMPIN^115.1~RIFAMPIN INTERP^115.2~RIFAMPIN SCREEN

 +25      ;;2.0025^120~NOVOBIOCIN^120.1~NOVOBIOCIN INTERP^120.2~NOVOBIOCIN SCREEN

 +26      ;;2.0026^125~CEFOPERAZONE^125.1~CEFOPERAZONE INTERP^125.2~CEFOPERAZONE SCREEN

 +27      ;;2.0027^130~MEZLOCILLIN^130.1~MEZLOCILLIN INTERP^130.2~MEZLOCILLIN SCREEN

 +28      ;;2.0028^135~MOXALACTAM^135.1~MOXALACTAM INTERP^135.2~MOXALACTAM SCREEN

 +29      ;;2.0029^140~NETILMICIN^140.1~NETILMICIN INTERP^140.2~NETILMICIN SCREEN

 +30      ;;

 +31      ;;2.0031^151~SULFISOXAZOLE^151.1~SULFISOXAZOLE INTERP^151.2~SULFISOXAZOLE SCREEN

 +32      ;;2.0032^152~NAFCILLIN^152.1~NAFCILLIN INTERP^152.2~NAFCILLIN SCREEN

 +33      ;;2.0033^153~NALIDIXIC ACID^153.1~NALIDIXIC ACID INTERP^153.2~NALIDIXIC ACID SCREEN

 +34      ;;2.0034^154~CEPHALOTHIN^154.1~CEPHALOTHIN INTERP^154.2~CEPHALOTHIN SCREEN

 +35      ;;2.0035^155~COLISTIN^155.1~COLISTIN INTERP^155.2~COLISTIN SCREEN

 +36      ;;2.0036^156~METRONIDAZOLE^156.1~METRONIDAZOLE INTERP^156.2~METRONIDAZOLE SCREEN

 +37      ;;2.0037^157~CEFUROXIME^157.1~CEFUROXIME INTERP^157.2~CEFUROXIME SCREEN

 +38      ;;2.0038^158~CEFTIZOXIME^158.1~CEFTIZOXIME INTERP^158.2~CEFTIZOXIME SCREEN

 +39      ;;2.0039^159~SPECTINOMYCIN^159.1~SPECTINOMYCIN INTERP^159.2~SPECTINOMYCIN SCREEN

 +40       QUIT

 +41      ;

 +42      ;Pass back field name of Mycobacterium Antibiotic field.  If the

 +43      ; Antibiotic field node is lonnger than six characters it is site

 +44      ; specific and is not returned.

 +45      ;

DECODEMB(VAL) ;  ---Decode Mycobacterium antibiotics

 +1       ;

 +2        NEW STR,MVAL,M1VAL

 +3        SET STR=""

 +4        IF $EXTRACT(VAL,1,4)'="2.00"

               QUIT ""

 +5        IF 'VAL

               QUIT ""

 +6        IF $LENGTH(VAL)>6

               QUIT ""

 +7        SET VAL=$PIECE(VAL,".",2)

 +8        IF VAL="001"

               Begin DoDot:1

 +9                SET STR="2.001^50~PYRAZINAMIDE"

               End DoDot:1

 +10       IF $LENGTH(VAL)=4

               Begin DoDot:1

 +11               SET M1VAL=+VAL

 +12               SET STR=$PIECE($TEXT(MBCODE+M1VAL),";;",2)

               End DoDot:1

 +13       QUIT STR

 +14      ;

MBCODE    ;

 +1       ;;2.0001^5~STR

 +2       ;;2.0002^10~PAS

 +3       ;;2.0003^15~INH

 +4       ;;2.0004^20~ETH

 +5       ;;2.0005^25~RIF

 +6       ;;2.0006^30~KANAMYCIN

 +7       ;;2.0007^35~CAPREOMYCIN

 +8       ;;2.0008^40~CYCLOSERINE

 +9       ;;2.0009^45~ETHIONAMIDE

 +10      ;;

 +11      ;;2.0011^55~MIOMYCIN

 +12       QUIT

 +13      ;

 +14      ;

 +15      ;

ARRANGE(LAARRAY,LAARRET) ; Re-set the global to the passed in reference and re-arrage for easier processing.

 +1       ;

 +2        FOR LASET="63.05","63.29","63.3","63.31","63.32","63.33","63.34","63.35","63.351","63.36","63.37","63.372","63.39","63.4","63.43","63.341","63.291","63.371","63.44"

               Begin DoDot:1

 +3                SET LACD=""

 +4                FOR

                       SET LACD=$ORDER(@LAARRAY@(LASET,LACD))

                       IF LACD=""

                           QUIT

                       Begin DoDot:2

 +5                        SET LACDFLD=""

 +6                        FOR

                               SET LACDFLD=$ORDER(@LAARRAY@(LASET,LACD,LACDFLD))

                               IF LACDFLD=""

                                   QUIT

                               Begin DoDot:3

 +7                                SET LACDTYP=""

 +8                                FOR

                                       SET LACDTYP=$ORDER(@LAARRAY@(LASET,LACD,LACDFLD,LACDTYP))

                                       IF LACDTYP=""

                                           QUIT

                                       Begin DoDot:4

 +9                                        SET LADATA=@LAARRAY@(LASET,LACD,LACDFLD,LACDTYP)

 +10      ;

 +11                                       IF LASET="63.05"

                                               Begin DoDot:5

 +12                                               SET @LAARRET@($PIECE(LACD,",",2),$PIECE(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA

                                                   QUIT

                                               End DoDot:5

                                               QUIT

 +13      ;

 +14                                       IF LASET="63.351"

                                               Begin DoDot:5

 +15                                               SET @LAARRET@($PIECE(LACD,",",5),$PIECE(LACD,",",4),"6",$PIECE(LACD,",",3),"1",$PIECE(LACD,",",2),"1",$PIECE(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA

                                                   QUIT

                                               End DoDot:5

                                               QUIT

 +16      ;

 +17                                       IF LASET="63.32"

                                               Begin DoDot:5

 +18                                               SET @LAARRET@($PIECE(LACD,",",4),$PIECE(LACD,",",3),3,$PIECE(LACD,",",2),3,$PIECE(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA

                                                   QUIT

                                               End DoDot:5

                                               QUIT

 +19      ;

 +20                                       IF LASET="63.31"!(LASET="63.35")!(LASET="63.372")!(LASET="63.4")

                                               Begin DoDot:5

 +21                                               SET LASUB=$SELECT(LASET="63.31":"3",LASET="63.35":"6",LASET="63.372":"9",LASET="63.4":"12",1:"")

 +22                                               IF LASUB=""

                                                       QUIT

 +23                                               SET @LAARRET@($PIECE(LACD,",",4),$PIECE(LACD,",",3),LASUB,$PIECE(LACD,",",2),"1",$PIECE(LACD,",",1),"0",LACDFLD,LACDTYP)=LADATA

                                                   QUIT

                                               End DoDot:5

                                               QUIT

 +24      ;

 +25                                       SET LASUB=$SELECT(LASET="63.29":"2",LASET="63.3":"3",LASET="63.33":"4",LASET="63.34":"6",LASET="63.36":"7",LASET="63.37":"9",1:"")

 +26                                       IF LASUB=""

                                               SET LASUB=$SELECT(LASET="63.39":"12",LASET="63.43":"17",LASET="63.341":"24",LASET="63.291":"25",LASET="63.371":"15",LASET="63.44":"18",1:"")

 +27                                       IF LASUB=""

                                               QUIT

 +28                                       SET @LAARRET@($PIECE(LACD,",",3),$PIECE(LACD,",",2),LASUB,$PIECE(LACD,",",1),0,LACDFLD,LACDTYP)=LADATA

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +29      ;

 +30      ; - Kill local array

 +31       KILL @LAARRAY

 +32       QUIT

 +33      ;

 +34      ;

LA7UTL1B.m