- LRMIXR3 ;SLC/BA - ANTIBIOTIC INTERPRETATION ^LAB(62.06,"AI", X-REF ; 4/4/87 21:05 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- ALT ;sets "AI" x-ref alternate interpretation when ALTERNATE INTERPRETATION, ORGANISM (INTRP), or SPECIMEN (INTRP) is entered
- S K0=DA(2),K1=DA(1),K2=DA,J4=X I $L($P(^LAB(62.06,K0,0),U,2)) S J0=$P(^(0),U,2),J1=$P(^LAB(62.06,K0,1,K1,0),U) I $D(^LAB(62.06,K0,1,K1,2,K2,0)),$L($P(^(0),U,2)),$L($P(^(0),U,3)) S J2=$P(^(0),U,2),J3=$P(^(0),U,3) D SETUP
- K J0,J1,J2,J3,J4,J9,K0,K1,K2
- Q
- ALTO ;sets "AI" x-ref alternate interpretation when ORGANISM (INTRP) is entered
- S K0=DA(2),K1=DA(1),K2=DA,J2=X I $L($P(^LAB(62.06,K0,0),U,2)) S J0=$P(^(0),U,2),J1=$P(^LAB(62.06,K0,1,K1,0),U) I $D(^LAB(62.06,K0,1,K1,2,K2,0)),$L($P(^(0),U,3)) S J3=$P(^(0),U,3),J4=$P(^(0),U) D SETUP
- K J0,J1,J2,J3,J4,K0,K1,K2
- Q
- ALTS ;sets "AI" x-ref alternate interpretation when SPECIMEN (INTRP) is entered
- S K0=DA(2),K1=DA(1),K2=DA,J3=X I $L($P(^LAB(62.06,K0,0),U,2)) S J0=$P(^(0),U,2),J1=$P(^LAB(62.06,K0,1,K1,0),U) I $D(^LAB(62.06,K0,1,K1,2,K2,0)),$L($P(^(0),U,2)) S J2=$P(^(0),U,2),J4=$P(^(0),U) D SETUP
- K J0,J1,J2,J3,J4,K0,K1,K2
- Q
- KALT ;kills "AI" x-ref alternate interpretation when ALTERNATE INTERPRETATION, ORGANISM (INTRP), or SPECIMEN (INTRP) are deleted
- I $L($P(^LAB(62.06,DA(2),0),U,2)) S J0=$P(^(0),U,2),J1=$P(^LAB(62.06,DA(2),1,DA(1),0),U) I $L($P(^LAB(62.06,DA(2),1,DA(1),2,DA,0),U,2)),$L($P(^(0),U,3)) S J2=$P(^(0),U,2),J3=$P(^(0),U,3) D SWITCH K ^LAB(62.06,"AI",J0,J1,J2,J3)
- K J0,J1,J2,J3
- Q
- BUGNODE ;sets "AI" x-ref when entering BUG NODE
- S K0=DA,J0=+X,^LAB(62.06,"AI",J0)=K0_U_$P(^LAB(62.06,K0,0),U,5)
- S K1=0 F I=0:0 S K1=+$O(^LAB(62.06,K0,1,K1)) Q:K1<1 I $D(^(K1,0)),$L($P(^(0),U)) S J1=$P(^(0),U),^LAB(62.06,"AI",+X,J1)=$P(^(0),U,2) D RESULT
- K K0,K1,K2,J0,J1,J2,J3,J9
- Q
- RESULT S K2=0 F I=0:0 S K2=+$O(^LAB(62.06,K0,1,K1,2,K2)) Q:K2<1 I $D(^(K2,0)),$L($P(^(0),U,2)),$L($P(^(0),U,3)) S J2=$P(^(0),U,2),J3=$P(^(0),U,3),J4=$P(^(0),U) D SETUP
- Q
- SETUP D SWITCH S ^LAB(62.06,"AI",J0,J1,J2,J3)=J4
- Q
- SWITCH S J9=$P(^LAB(61.2,J2,0),U),J2=$S(J9["UNKNOWN":"ANY",J9["GRAM POS":"GRAM POS",J9["GRAM NEG":"GRAM NEG",1:J2),J9=$P(^LAB(61,J3,0),U),J3=$S(J9["UNKNOWN":"ANY",1:J3)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIXR3 2209 printed Feb 18, 2025@23:43:45 Page 2
- LRMIXR3 ;SLC/BA - ANTIBIOTIC INTERPRETATION ^LAB(62.06,"AI", X-REF ; 4/4/87 21:05 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- ALT ;sets "AI" x-ref alternate interpretation when ALTERNATE INTERPRETATION, ORGANISM (INTRP), or SPECIMEN (INTRP) is entered
- +1 SET K0=DA(2)
- SET K1=DA(1)
- SET K2=DA
- SET J4=X
- IF $LENGTH($PIECE(^LAB(62.06,K0,0),U,2))
- SET J0=$PIECE(^(0),U,2)
- SET J1=$PIECE(^LAB(62.06,K0,1,K1,0),U)
- IF $DATA(^LAB(62.06,K0,1,K1,2,K2,0))
- IF $LENGTH($PIECE(^(0),U,2))
- IF $LENGTH($PIECE(^(0),U,3))
- SET J2=$PIECE(^(0),U,2)
- SET J3=$PIECE(^(0),U,3)
- DO SETUP
- +2 KILL J0,J1,J2,J3,J4,J9,K0,K1,K2
- +3 QUIT
- ALTO ;sets "AI" x-ref alternate interpretation when ORGANISM (INTRP) is entered
- +1 SET K0=DA(2)
- SET K1=DA(1)
- SET K2=DA
- SET J2=X
- IF $LENGTH($PIECE(^LAB(62.06,K0,0),U,2))
- SET J0=$PIECE(^(0),U,2)
- SET J1=$PIECE(^LAB(62.06,K0,1,K1,0),U)
- IF $DATA(^LAB(62.06,K0,1,K1,2,K2,0))
- IF $LENGTH($PIECE(^(0),U,3))
- SET J3=$PIECE(^(0),U,3)
- SET J4=$PIECE(^(0),U)
- DO SETUP
- +2 KILL J0,J1,J2,J3,J4,K0,K1,K2
- +3 QUIT
- ALTS ;sets "AI" x-ref alternate interpretation when SPECIMEN (INTRP) is entered
- +1 SET K0=DA(2)
- SET K1=DA(1)
- SET K2=DA
- SET J3=X
- IF $LENGTH($PIECE(^LAB(62.06,K0,0),U,2))
- SET J0=$PIECE(^(0),U,2)
- SET J1=$PIECE(^LAB(62.06,K0,1,K1,0),U)
- IF $DATA(^LAB(62.06,K0,1,K1,2,K2,0))
- IF $LENGTH($PIECE(^(0),U,2))
- SET J2=$PIECE(^(0),U,2)
- SET J4=$PIECE(^(0),U)
- DO SETUP
- +2 KILL J0,J1,J2,J3,J4,K0,K1,K2
- +3 QUIT
- KALT ;kills "AI" x-ref alternate interpretation when ALTERNATE INTERPRETATION, ORGANISM (INTRP), or SPECIMEN (INTRP) are deleted
- +1 IF $LENGTH($PIECE(^LAB(62.06,DA(2),0),U,2))
- SET J0=$PIECE(^(0),U,2)
- SET J1=$PIECE(^LAB(62.06,DA(2),1,DA(1),0),U)
- IF $LENGTH($PIECE(^LAB(62.06,DA(2),1,DA(1),2,DA,0),U,2))
- IF $LENGTH($PIECE(^(0),U,3))
- SET J2=$PIECE(^(0),U,2)
- SET J3=$PIECE(^(0),U,3)
- DO SWITCH
- KILL ^LAB(62.06,"AI",J0,J1,J2,J3)
- +2 KILL J0,J1,J2,J3
- +3 QUIT
- BUGNODE ;sets "AI" x-ref when entering BUG NODE
- +1 SET K0=DA
- SET J0=+X
- SET ^LAB(62.06,"AI",J0)=K0_U_$PIECE(^LAB(62.06,K0,0),U,5)
- +2 SET K1=0
- FOR I=0:0
- SET K1=+$ORDER(^LAB(62.06,K0,1,K1))
- if K1<1
- QUIT
- IF $DATA(^(K1,0))
- IF $LENGTH($PIECE(^(0),U))
- SET J1=$PIECE(^(0),U)
- SET ^LAB(62.06,"AI",+X,J1)=$PIECE(^(0),U,2)
- DO RESULT
- +3 KILL K0,K1,K2,J0,J1,J2,J3,J9
- +4 QUIT
- RESULT SET K2=0
- FOR I=0:0
- SET K2=+$ORDER(^LAB(62.06,K0,1,K1,2,K2))
- if K2<1
- QUIT
- IF $DATA(^(K2,0))
- IF $LENGTH($PIECE(^(0),U,2))
- IF $LENGTH($PIECE(^(0),U,3))
- SET J2=$PIECE(^(0),U,2)
- SET J3=$PIECE(^(0),U,3)
- SET J4=$PIECE(^(0),U)
- DO SETUP
- +1 QUIT
- SETUP DO SWITCH
- SET ^LAB(62.06,"AI",J0,J1,J2,J3)=J4
- +1 QUIT
- SWITCH SET J9=$PIECE(^LAB(61.2,J2,0),U)
- SET J2=$SELECT(J9["UNKNOWN":"ANY",J9["GRAM POS":"GRAM POS",J9["GRAM NEG":"GRAM NEG",1:J2)
- SET J9=$PIECE(^LAB(61,J3,0),U)
- SET J3=$SELECT(J9["UNKNOWN":"ANY",1:J3)
- +1 QUIT
