- LRMIZAP1 ;SLC/BA - MICRO CONVERSION ; 4/4/87 21:05 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- XX ;from LRMIZAP
- F I=0:0 S L=+$O(^LR(L)) Q:L<1 W:L#100=0 !,L S ^TMP("LRMIZAP",$J,"ZAP")=L,T=0 F I=0:0 S T=+$O(^LR(L,"MI",T)) Q:T<1 S B=0 F I=0:0 S B=+$O(^LR(L,"MI",T,3,B)) Q:B<1 D P
- Q
- P S N=0 F I=0:0 S N=+$O(^TMP("LRMIZAP",$J,N)) Q:N<1 I $D(^LR(L,"MI",T,3,B,N)),$L($P(^(N),U)),$D(^TMP("LRMIZAP",$J,N,$P(^(N),U))) S C=^TMP("LRMIZAP",$J,N,$P(^LR(L,"MI",T,3,B,N),U)) D C
- Q
- C I $P(C,U,2)="*" D ALT Q
- S $P(^LR(L,"MI",T,3,B,N),U,2)=$P(C,U) Q
- Q
- ALT I '$D(^LR(L,"MI",T,3,B,0)) Q
- S Y(0)=^LR(L,"MI",T,3,B,0),C6=$P(C,U,3),C4=$P(C,U,4),LRISR=$P(C,U) D ISR S $P(^LR(L,"MI",T,3,B,N),U,2)=LRISR
- Q
- ISR S LROVERR=0,C2=0 F I=0:0 S C2=$O(^LAB(62.06,C6,1,C4,1,C2)) Q:C2<1 I $D(^(C2,0)),+^(0)=+Y(0) S LRISR=$P(^(0),U,2),LROVERR=1 Q
- I LROVERR Q
- S C2=0 F I=0:0 S C2=$O(^LAB(62.06,C6,1,C4,1,C2)) Q:C2<1 S LRORIDE=^(C2,0),LRBUGN=$P(^LAB(61.2,+LRORIDE,0),U) I LRBUGN["GRAM POS"!(LRBUGN["GRAM NEG") D GSCHECK Q
- I LROVERR S LRISR=$P(^LAB(62.06,C6,1,C4,1,C2,0),U,2) Q
- S LRISR=$P(^LAB(62.06,C6,1,C4,0),U,2)
- Q
- GSCHECK I LRBUGN["GRAM POS",$P(^LAB(61.2,+Y(0),0),U,3)="P" S LROVERR=1
- I LRBUGN["GRAM NEG",$P(^LAB(61.2,+Y(0),0),U,3)="N" S LROVERR=1
- Q
- ZZ ;from LRMIZAP
- F I=0:0 S L=+$O(^LR(L)) Q:L<1 S ^TMP("LRMIZAP",$J,"UNZAP")=L,T=0 F I=0:0 S T=+$O(^LR(L,"MI",T)) Q:T<1 S B=0 F I=0:0 S B=+$O(^LR(L,"MI",T,3,B)) Q:B<1 D Z
- Q
- Z S N=0 F I=0:0 S N=+$O(^TMP("LRMIZAP",$J,N)) Q:N<1 I $D(^LR(L,"MI",T,3,B,N)),$L($P(^(N),U)),$D(^TMP("LRMIZAP",$J,N,$P(^(N),U))) W "." S ^LR(L,"MI",T,3,B,N)=$P(^LR(L,"MI",T,3,B,N),U)
- Q
- ;L=LRDFN, T=LRIDT, B=bug#, N=bugnode of antibiotic
- ;^TMP("LRMIZAP",$J,"ZAP")=LRDFN of last patient processed
- ;C=^TMP("LRMIZAP",$J,bugnode,result)=interpretation
- ;if an alt interpretation "" "" )=interpretation^*^antibiotic#^result#
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIZAP1 1860 printed Jan 18, 2025@03:18:37 Page 2
- LRMIZAP1 ;SLC/BA - MICRO CONVERSION ; 4/4/87 21:05 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- XX ;from LRMIZAP
- +1 FOR I=0:0
- SET L=+$ORDER(^LR(L))
- if L<1
- QUIT
- if L#100=0
- WRITE !,L
- SET ^TMP("LRMIZAP",$JOB,"ZAP")=L
- SET T=0
- FOR I=0:0
- SET T=+$ORDER(^LR(L,"MI",T))
- if T<1
- QUIT
- SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(L,"MI",T,3,B))
- if B<1
- QUIT
- DO P
- +2 QUIT
- P SET N=0
- FOR I=0:0
- SET N=+$ORDER(^TMP("LRMIZAP",$JOB,N))
- if N<1
- QUIT
- IF $DATA(^LR(L,"MI",T,3,B,N))
- IF $LENGTH($PIECE(^(N),U))
- IF $DATA(^TMP("LRMIZAP",$JOB,N,$PIECE(^(N),U)))
- SET C=^TMP("LRMIZAP",$JOB,N,$PIECE(^LR(L,"MI",T,3,B,N),U))
- DO C
- +1 QUIT
- C IF $PIECE(C,U,2)="*"
- DO ALT
- QUIT
- +1 SET $PIECE(^LR(L,"MI",T,3,B,N),U,2)=$PIECE(C,U)
- QUIT
- +2 QUIT
- ALT IF '$DATA(^LR(L,"MI",T,3,B,0))
- QUIT
- +1 SET Y(0)=^LR(L,"MI",T,3,B,0)
- SET C6=$PIECE(C,U,3)
- SET C4=$PIECE(C,U,4)
- SET LRISR=$PIECE(C,U)
- DO ISR
- SET $PIECE(^LR(L,"MI",T,3,B,N),U,2)=LRISR
- +2 QUIT
- ISR SET LROVERR=0
- SET C2=0
- FOR I=0:0
- SET C2=$ORDER(^LAB(62.06,C6,1,C4,1,C2))
- if C2<1
- QUIT
- IF $DATA(^(C2,0))
- IF +^(0)=+Y(0)
- SET LRISR=$PIECE(^(0),U,2)
- SET LROVERR=1
- QUIT
- +1 IF LROVERR
- QUIT
- +2 SET C2=0
- FOR I=0:0
- SET C2=$ORDER(^LAB(62.06,C6,1,C4,1,C2))
- if C2<1
- QUIT
- SET LRORIDE=^(C2,0)
- SET LRBUGN=$PIECE(^LAB(61.2,+LRORIDE,0),U)
- IF LRBUGN["GRAM POS"!(LRBUGN["GRAM NEG")
- DO GSCHECK
- QUIT
- +3 IF LROVERR
- SET LRISR=$PIECE(^LAB(62.06,C6,1,C4,1,C2,0),U,2)
- QUIT
- +4 SET LRISR=$PIECE(^LAB(62.06,C6,1,C4,0),U,2)
- +5 QUIT
- GSCHECK IF LRBUGN["GRAM POS"
- IF $PIECE(^LAB(61.2,+Y(0),0),U,3)="P"
- SET LROVERR=1
- +1 IF LRBUGN["GRAM NEG"
- IF $PIECE(^LAB(61.2,+Y(0),0),U,3)="N"
- SET LROVERR=1
- +2 QUIT
- ZZ ;from LRMIZAP
- +1 FOR I=0:0
- SET L=+$ORDER(^LR(L))
- if L<1
- QUIT
- SET ^TMP("LRMIZAP",$JOB,"UNZAP")=L
- SET T=0
- FOR I=0:0
- SET T=+$ORDER(^LR(L,"MI",T))
- if T<1
- QUIT
- SET B=0
- FOR I=0:0
- SET B=+$ORDER(^LR(L,"MI",T,3,B))
- if B<1
- QUIT
- DO Z
- +2 QUIT
- Z SET N=0
- FOR I=0:0
- SET N=+$ORDER(^TMP("LRMIZAP",$JOB,N))
- if N<1
- QUIT
- IF $DATA(^LR(L,"MI",T,3,B,N))
- IF $LENGTH($PIECE(^(N),U))
- IF $DATA(^TMP("LRMIZAP",$JOB,N,$PIECE(^(N),U)))
- WRITE "."
- SET ^LR(L,"MI",T,3,B,N)=$PIECE(^LR(L,"MI",T,3,B,N),U)
- +1 QUIT
- +2 ;L=LRDFN, T=LRIDT, B=bug#, N=bugnode of antibiotic
- +3 ;^TMP("LRMIZAP",$J,"ZAP")=LRDFN of last patient processed
- +4 ;C=^TMP("LRMIZAP",$J,bugnode,result)=interpretation
- +5 ;if an alt interpretation "" "" )=interpretation^*^antibiotic#^result#