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
Q
;
;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
Q
;
;
;
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
Q
;
;
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 ;
