- LRMIXR1 ;SLC/BA - X-REF FOR ANTIBIOTIC INTERPRETATION ^LAB(62.06,"AJ") ; 8/5/87 10:40 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- KINT ;kills "AJ" x-ref and then resets it when INTERPRETATION is deleted
- S K0=DA(1) D KILL
- Q
- KAINT ;kills "AJ" x-ref and then resets it when ALTERNATE INTERPRETATION is deleted
- S K0=DA(2) D KILL
- Q
- KILL I $L($P(^LAB(62.06,K0,0),U,2)) S K9=+$P(^(0),U,2) K ^LAB(62.06,"AJ",K9,X) D SET
- K K0 S K9=DA(1) N DA,X
- S DA=K9 S X=$P($G(^LAB(62.06,+DA,0)),U,2) D ^LRMIXALL
- Q
- BUGNODE ;sets "AJ" x-ref when entering BUG NODE
- S K0=DA,K9=+X I K9'<2 D SET
- Q
- SET 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,2)) S ^LAB(62.06,"AJ",K9,$P(^(0),U,2))="" D ALT
- K K0,K1,K2,K9
- Q
- ALT 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)),$L($P(^(0),U,2)),$L($P(^(0),U,3)) S ^LAB(62.06,"AJ",K9,$P(^(0),U))=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIXR1 905 printed Jan 18, 2025@03:18:34 Page 2
- LRMIXR1 ;SLC/BA - X-REF FOR ANTIBIOTIC INTERPRETATION ^LAB(62.06,"AJ") ; 8/5/87 10:40 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- KINT ;kills "AJ" x-ref and then resets it when INTERPRETATION is deleted
- +1 SET K0=DA(1)
- DO KILL
- +2 QUIT
- KAINT ;kills "AJ" x-ref and then resets it when ALTERNATE INTERPRETATION is deleted
- +1 SET K0=DA(2)
- DO KILL
- +2 QUIT
- KILL IF $LENGTH($PIECE(^LAB(62.06,K0,0),U,2))
- SET K9=+$PIECE(^(0),U,2)
- KILL ^LAB(62.06,"AJ",K9,X)
- DO SET
- +1 KILL K0
- SET K9=DA(1)
- NEW DA,X
- +2 SET DA=K9
- SET X=$PIECE($GET(^LAB(62.06,+DA,0)),U,2)
- DO ^LRMIXALL
- +3 QUIT
- BUGNODE ;sets "AJ" x-ref when entering BUG NODE
- +1 SET K0=DA
- SET K9=+X
- IF K9'<2
- DO SET
- +2 QUIT
- SET 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,2))
- SET ^LAB(62.06,"AJ",K9,$PIECE(^(0),U,2))=""
- DO ALT
- +1 KILL K0,K1,K2,K9
- +2 QUIT
- ALT 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))
- IF $LENGTH($PIECE(^(0),U,2))
- IF $LENGTH($PIECE(^(0),U,3))
- SET ^LAB(62.06,"AJ",K9,$PIECE(^(0),U))=""
- +1 QUIT