- LR7OSMZ5 ;DALOI/STAFF - Silent Micro rpt - BACTERIA, ANTIBIOTICS ;05/24/11 14:47
- ;;5.2;LAB SERVICE;**121,187,244,350,437**;Sep 27, 1994;Build 3
- ;
- BACT ;from LR7OSMZ2
- ;
- N A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI,LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
- ;
- Q:+$O(^LR(LRDFN,"MI",LRIDT,3,0))<1
- ;
- S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
- ;
- ; Check each organism identified on the specimen.
- ; A = number of organisms on report that have susceptibilities
- S (A,LRBUG)=0
- F S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D
- . I +$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2." Q
- . S A=A+1 D CHECK
- ;
- S (LRBN,LRABCNT)=0
- F S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1 S LRABCNT=LRABCNT+1
- Q:'LRABCNT
- ;
- ; Scan result to find longest value, set mininium field width = 4
- S (LRI,LRMAX(1))=0
- F S LRI=$O(LRRES(LRI)) Q:'LRI D
- . F I=1:1:A D
- . . S X=$L($P(LRRES(LRI),"^",I))
- . . I X<4 S X=4
- . . I X>$G(LRWIDTH(I,1)) S LRWIDTH(I,1)=X
- . . I X>LRMAX(1) S LRMAX(1)=X
- ;
- ; Scan interpretations to find longest value
- S (LRI,LRMAX(2))=0
- F S LRI=$O(LRINT(LRI)) Q:'LRI D
- . F I=1:1:A D
- . . S X=$L($P(LRINT(LRI),"^",I))
- . . I X<4 S X=4
- . . I X>$G(LRWIDTH(I,2)) S LRWIDTH(I,2)=X
- . . I X>LRMAX(2) S LRMAX(2)=X
- ;
- ; Find longest antibiotic display comment to display on report
- S (LRCOMMAX,LRI)=0
- F S LRI=$O(^LAB(62.06,LRI)) Q:'LRI D
- . S LRX=$G(^LAB(62.06,LRI,0)) Q:$P(LRX,"^",3)=""
- . I '$P(LRX,"^",2) Q
- . S LRY=0
- . F S LRY=$O(^LR(LRDFN,"MI",LRIDT,3,LRY)) Q:'LRY D
- . . I $D(^LR(LRDFN,"MI",LRIDT,3,LRY,$P(LRX,"^",2))) S X=$L($P(LRX,"^",3)) S:X>LRCOMMAX LRCOMMAX=X
- ;
- ; Check display width so that at least one organsism's values will display when display width is limited
- ; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
- I LRCOMMAX>10,GIOM'>80 D
- . I LRFMT="B" S X=LRMAX(1)+LRMAX(2)+4
- . I LRFMT="R" S X=LRMAX(1)+2
- . I LRFMT="I" S X=LRMAX(2)+2
- . S X=X+31
- . I (X+LRCOMMAX)>GIOM S LRCOMMAX=GIOM-X
- ;
- ; Determine tab position (column) of each organism and associated results
- ; LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
- S (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0,LRSECT=1,LRTAB(LRSECT,0)=29
- F S LRI=$O(LRWIDTH(LRI)) Q:'LRI D
- . S LRX=LRTAB(LRSECT,LRI-1)
- . I LRFMT="B" D Q
- . . S LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
- . . I (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
- . . S LRTAB(LRSECT,LRI)=LRY
- . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
- . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
- . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
- . I LRFMT="I" D Q
- . . S LRY=LRX+LRWIDTH(LRI-1,2)+4
- . . I (LRY+LRCOMMAX+LRWIDTH(LRI,2))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
- . . S LRTAB(LRSECT,LRI)=LRY
- . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
- . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
- . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
- . I LRFMT="R" D Q
- . . S LRY=LRX+LRWIDTH(LRI-1,1)+4
- . . I (LRY+LRCOMMAX+LRWIDTH(LRI,1))>GIOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
- . . S LRTAB(LRSECT,LRI)=LRY
- . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
- . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
- . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
- ;
- D LINE^LR7OSUM4,LINE^LR7OSUM4
- S X="ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
- I $D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW) S X=X_" ('*' indicates display is suppressed)"
- S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
- D LINE^LR7OSUM4
- ;
- S LRSECT=0
- F S LRSECT=$O(LRTAB(LRSECT)) Q:'LRSECT D SECT
- ;
- Q
- ;
- ;
- SECT ; Print antibiotic susceptibility for each section
- ;
- N LRAO
- ;
- D BUGHDR
- ;
- ; Display antibiotics by print order
- S LRAO=0
- F S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001 D
- . S B=$O(^LAB(62.06,"AO",LRAO,0))
- . I B>0,$D(^LAB(62.06,B,0)) D AB
- ;
- D LINE^LR7OSUM4
- ;
- Q
- ;
- ;
- CHECK ;
- ;
- N B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
- ;
- S LRFLAG=0,LRBN=2
- F S LRBN=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2." D
- . S B=^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN),B1=$P(B,U),B2=$P(B,U,2)
- . I B1'="" D FIRST
- ;
- S LRBN=2
- F S LRBN=+$O(LR1PASS(LRBN)) Q:LRBN<1 D
- . S B=LR1PASS(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3)
- . D LAB
- ;
- S LRBUG(A)=LRBUG
- ;
- Q
- ;
- ;
- FIRST ;
- ;
- ; If format is 'interpretation only' and no interpretation for this sensitivity then display sensitivity result in it's place.
- I B2="" S B2=$S(LRFMT="I":B1,1:" ")
- ;
- S B3=$P(B,U,3)
- I B2'=" ",$E(B2)'="R","A"[B3 S LRFLAG=1
- S LR1PASS(LRBN)=B1_U_B2_U_B3
- Q
- ;
- ;
- LAB ;
- I $D(^XUSEC("LRLAB",DUZ)),'$D(LRWRDVEW) D Q
- . S $P(LRRES(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
- . S $P(LRINT(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
- ;
- I B3=""!(B3="A")!(B3="R"&'LRFLAG) S $P(LRRES(LRBN),U,A)=B1,$P(LRINT(LRBN),U,A)=B2
- Q
- ;
- ;
- AB ;
- ;
- N LRX
- ;
- S LRX=$G(^LAB(62.06,B,0)),J=$P(LRX,"^",2)
- I J<1 Q
- ;
- I '$D(LRINT(J)) Q
- I LRINT(J)'="",LRINT(J)?."^" Q
- ;
- D LINE^LR7OSUM4
- ;
- ; Write name of antibiotic
- S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$$LJ^XLFSTR($P(LRX,U),30,"."))
- ;
- ; Antibiotic display comment from file #62.06
- K LRDCOM(0)
- S LRDCOM=$P(LRX,U,3)
- ; If longer than comment window (GIOM-LRCOMTAB) then format to fit within window.
- I $L(LRDCOM)>(GIOM-LRCOMTAB(LRSECT)) D
- . N J,K,L
- . S J=$L(LRDCOM),K=0,L=GIOM-LRCOMTAB(LRSECT)-1 S:L<1 L=1
- . F Q:LRDCOM="" S K=K+1,LRDCOM(0,K)=$E(LRDCOM,1,L),LRDCOM=$E(LRDCOM,L+1,J)
- ;
- D SIR
- Q
- ;
- ;
- BUGHDR ;
- ;
- N A,J
- F J=1:1 S LRBUG=$P(LRSECT(LRSECT),"^",J) Q:LRBUG="" D
- . S LRORG=$P(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U),LRORG=$P(^LAB(61.2,LRORG,0),U)
- . I +$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2." Q
- . D ORG
- ;
- I LRFMT="B" D
- . D LN^LR7OSMZ1
- . S ^TMP("LRC",$J,GCNT,0)=""
- . F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
- ;
- D LN^LR7OSMZ1
- S ^TMP("LRC",$J,GCNT,0)=""
- ;
- F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A="" D
- . I LRFMT'="B" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
- . I LRFMT="B" D
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,1),CCNT,"SUSC")
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,2),CCNT,"INTP")
- ;
- Q
- ;
- ;
- ORG ;
- ;
- ; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
- ;
- N J
- ;
- D LINE^LR7OSUM4
- ;
- S ^TMP("LRC",$J,GCNT,0)=""
- ;
- I LRBUG>$P(LRSECT(LRSECT),"^") F J=1:1 Q:$P(LRSECT(LRSECT),"^",J)=LRBUG S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,$P(LRSECT(LRSECT),"^",J)),CCNT,":")
- ;
- S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,LRBUG),CCNT,$S(LR2ORMOR:LRBUG(LRBUG)_". ",1:"")_LRORG)
- ;
- Q
- ;
- ;
- SIR ; Display the susceptibility results/interpretations
- ;
- N II,K
- ;
- F K=1:1 S II=$P(LRSECT(LRSECT),"^",K) Q:II="" D
- . I LRFMT="B" D Q
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$P(LRRES(J),U,II))
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$P(LRINT(J),U,II))
- . I LRFMT="I" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$P(LRINT(J),U,II)) Q
- . I LRFMT="R" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$P(LRRES(J),U,II)) Q
- ;
- D DCOM
- Q
- ;
- ;
- DCOM ; Show antibiotic's display comments
- ;
- I LRDCOM'="" D
- . I LRCOMTAB(LRSECT)<$X,$L(LRDCOM)>(GIOM-$X) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=""
- . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM)
- ;
- I $D(LRDCOM(0)) D
- . N J
- . S J=0
- . F S J=$O(LRDCOM(0,J)) Q:'J D
- . . I J>1 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=""
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(0,J))
- ;
- I $D(LRDCOM(J)) D
- . S K=0,A=0
- . F S A=+$O(LRDCOM(J,A)) Q:A<1 D
- . . D:'('K&(LRDCOM="")) LINE^LR7OSUM4
- . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(J,A)),K=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSMZ5 8344 printed Feb 18, 2025@23:31:30 Page 2
- LR7OSMZ5 ;DALOI/STAFF - Silent Micro rpt - BACTERIA, ANTIBIOTICS ;05/24/11 14:47
- +1 ;;5.2;LAB SERVICE;**121,187,244,350,437**;Sep 27, 1994;Build 3
- +2 ;
- BACT ;from LR7OSMZ2
- +1 ;
- +2 NEW A,I,J,K,L,LRABCNT,LRCOMMAX,LRCOMTAB,LRBUG,LRDCOM,LRFMT,LR1PASS,LRBN,LRI,LRINT,LRMAX,LRORG,LRRES,LRSECT,LRTAB,LRWIDTH,LRX,LRY,X,Y
- +3 ;
- +4 if +$ORDER(^LR(LRDFN,"MI",LRIDT,3,0))<1
- QUIT
- +5 ;
- +6 SET LRFMT=$PIECE(^LAB(69.9,1,0),U,11)
- SET LRFMT=$SELECT(LRFMT="":"I",1:LRFMT)
- +7 ;
- +8 ; Check each organism identified on the specimen.
- +9 ; A = number of organisms on report that have susceptibilities
- +10 SET (A,LRBUG)=0
- +11 FOR
- SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
- if LRBUG<1
- QUIT
- Begin DoDot:1
- +12 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))'["2."
- QUIT
- +13 SET A=A+1
- DO CHECK
- End DoDot:1
- +14 ;
- +15 SET (LRBN,LRABCNT)=0
- +16 FOR
- SET LRBN=+$ORDER(LRRES(LRBN))
- if LRBN<1
- QUIT
- SET LRABCNT=LRABCNT+1
- +17 if 'LRABCNT
- QUIT
- +18 ;
- +19 ; Scan result to find longest value, set mininium field width = 4
- +20 SET (LRI,LRMAX(1))=0
- +21 FOR
- SET LRI=$ORDER(LRRES(LRI))
- if 'LRI
- QUIT
- Begin DoDot:1
- +22 FOR I=1:1:A
- Begin DoDot:2
- +23 SET X=$LENGTH($PIECE(LRRES(LRI),"^",I))
- +24 IF X<4
- SET X=4
- +25 IF X>$GET(LRWIDTH(I,1))
- SET LRWIDTH(I,1)=X
- +26 IF X>LRMAX(1)
- SET LRMAX(1)=X
- End DoDot:2
- End DoDot:1
- +27 ;
- +28 ; Scan interpretations to find longest value
- +29 SET (LRI,LRMAX(2))=0
- +30 FOR
- SET LRI=$ORDER(LRINT(LRI))
- if 'LRI
- QUIT
- Begin DoDot:1
- +31 FOR I=1:1:A
- Begin DoDot:2
- +32 SET X=$LENGTH($PIECE(LRINT(LRI),"^",I))
- +33 IF X<4
- SET X=4
- +34 IF X>$GET(LRWIDTH(I,2))
- SET LRWIDTH(I,2)=X
- +35 IF X>LRMAX(2)
- SET LRMAX(2)=X
- End DoDot:2
- End DoDot:1
- +36 ;
- +37 ; Find longest antibiotic display comment to display on report
- +38 SET (LRCOMMAX,LRI)=0
- +39 FOR
- SET LRI=$ORDER(^LAB(62.06,LRI))
- if 'LRI
- QUIT
- Begin DoDot:1
- +40 SET LRX=$GET(^LAB(62.06,LRI,0))
- if $PIECE(LRX,"^",3)=""
- QUIT
- +41 IF '$PIECE(LRX,"^",2)
- QUIT
- +42 SET LRY=0
- +43 FOR
- SET LRY=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRY))
- if 'LRY
- QUIT
- Begin DoDot:2
- +44 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRY,$PIECE(LRX,"^",2)))
- SET X=$LENGTH($PIECE(LRX,"^",3))
- if X>LRCOMMAX
- SET LRCOMMAX=X
- End DoDot:2
- End DoDot:1
- +45 ;
- +46 ; Check display width so that at least one organsism's values will display when display width is limited
- +47 ; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
- +48 IF LRCOMMAX>10
- IF GIOM'>80
- Begin DoDot:1
- +49 IF LRFMT="B"
- SET X=LRMAX(1)+LRMAX(2)+4
- +50 IF LRFMT="R"
- SET X=LRMAX(1)+2
- +51 IF LRFMT="I"
- SET X=LRMAX(2)+2
- +52 SET X=X+31
- +53 IF (X+LRCOMMAX)>GIOM
- SET LRCOMMAX=GIOM-X
- End DoDot:1
- +54 ;
- +55 ; Determine tab position (column) of each organism and associated results
- +56 ; LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
- +57 SET (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0
- SET LRSECT=1
- SET LRTAB(LRSECT,0)=29
- +58 FOR
- SET LRI=$ORDER(LRWIDTH(LRI))
- if 'LRI
- QUIT
- Begin DoDot:1
- +59 SET LRX=LRTAB(LRSECT,LRI-1)
- +60 IF LRFMT="B"
- Begin DoDot:2
- +61 SET LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
- +62 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>GIOM
- SET LRCOMTAB(LRSECT)=LRY
- SET LRY=LRTAB(1,0)+4
- SET LRSECT=LRSECT+1
- +63 SET LRTAB(LRSECT,LRI)=LRY
- +64 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- +65 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
- +66 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
- +67 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
- End DoDot:2
- QUIT
- +68 IF LRFMT="I"
- Begin DoDot:2
- +69 SET LRY=LRX+LRWIDTH(LRI-1,2)+4
- +70 IF (LRY+LRCOMMAX+LRWIDTH(LRI,2))>GIOM
- SET LRCOMTAB(LRSECT)=LRY
- SET LRY=LRTAB(1,0)+4
- SET LRSECT=LRSECT+1
- +71 SET LRTAB(LRSECT,LRI)=LRY
- +72 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- +73 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
- +74 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
- +75 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
- End DoDot:2
- QUIT
- +76 IF LRFMT="R"
- Begin DoDot:2
- +77 SET LRY=LRX+LRWIDTH(LRI-1,1)+4
- +78 IF (LRY+LRCOMMAX+LRWIDTH(LRI,1))>GIOM
- SET LRCOMTAB(LRSECT)=LRY
- SET LRY=LRTAB(1,0)+4
- SET LRSECT=LRSECT+1
- +79 SET LRTAB(LRSECT,LRI)=LRY
- +80 SET LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
- +81 SET LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
- +82 SET LRSECT(LRSECT)=$GET(LRSECT(LRSECT))_LRI_"^"
- +83 SET LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
- End DoDot:2
- QUIT
- End DoDot:1
- +84 ;
- +85 DO LINE^LR7OSUM4
- DO LINE^LR7OSUM4
- +86 SET X="ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
- +87 IF $DATA(^XUSEC("LRLAB",DUZ))&'$DATA(LRWRDVEW)
- SET X=X_" ('*' indicates display is suppressed)"
- +88 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,X)
- +89 DO LINE^LR7OSUM4
- +90 ;
- +91 SET LRSECT=0
- +92 FOR
- SET LRSECT=$ORDER(LRTAB(LRSECT))
- if 'LRSECT
- QUIT
- DO SECT
- +93 ;
- +94 QUIT
- +95 ;
- +96 ;
- SECT ; Print antibiotic susceptibility for each section
- +1 ;
- +2 NEW LRAO
- +3 ;
- +4 DO BUGHDR
- +5 ;
- +6 ; Display antibiotics by print order
- +7 SET LRAO=0
- +8 FOR
- SET LRAO=$ORDER(^LAB(62.06,"AO",LRAO))
- if LRAO<.001
- QUIT
- Begin DoDot:1
- +9 SET B=$ORDER(^LAB(62.06,"AO",LRAO,0))
- +10 IF B>0
- IF $DATA(^LAB(62.06,B,0))
- DO AB
- End DoDot:1
- +11 ;
- +12 DO LINE^LR7OSUM4
- +13 ;
- +14 QUIT
- +15 ;
- +16 ;
- CHECK ;
- +1 ;
- +2 NEW B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
- +3 ;
- +4 SET LRFLAG=0
- SET LRBN=2
- +5 FOR
- SET LRBN=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN))
- if LRBN'["2."
- QUIT
- Begin DoDot:1
- +6 SET B=^LR(LRDFN,"MI",LRIDT,3,LRBUG,LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- +7 IF B1'=""
- DO FIRST
- End DoDot:1
- +8 ;
- +9 SET LRBN=2
- +10 FOR
- SET LRBN=+$ORDER(LR1PASS(LRBN))
- if LRBN<1
- QUIT
- Begin DoDot:1
- +11 SET B=LR1PASS(LRBN)
- SET B1=$PIECE(B,U)
- SET B2=$PIECE(B,U,2)
- SET B3=$PIECE(B,U,3)
- +12 DO LAB
- End DoDot:1
- +13 ;
- +14 SET LRBUG(A)=LRBUG
- +15 ;
- +16 QUIT
- +17 ;
- +18 ;
- FIRST ;
- +1 ;
- +2 ; If format is 'interpretation only' and no interpretation for this sensitivity then display sensitivity result in it's place.
- +3 IF B2=""
- SET B2=$SELECT(LRFMT="I":B1,1:" ")
- +4 ;
- +5 SET B3=$PIECE(B,U,3)
- +6 IF B2'=" "
- IF $EXTRACT(B2)'="R"
- IF "A"[B3
- SET LRFLAG=1
- +7 SET LR1PASS(LRBN)=B1_U_B2_U_B3
- +8 QUIT
- +9 ;
- +10 ;
- LAB ;
- +1 IF $DATA(^XUSEC("LRLAB",DUZ))
- IF '$DATA(LRWRDVEW)
- Begin DoDot:1
- +2 SET $PIECE(LRRES(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
- +3 SET $PIECE(LRINT(LRBN),U,A)=$SELECT(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
- End DoDot:1
- QUIT
- +4 ;
- +5 IF B3=""!(B3="A")!(B3="R"&'LRFLAG)
- SET $PIECE(LRRES(LRBN),U,A)=B1
- SET $PIECE(LRINT(LRBN),U,A)=B2
- +6 QUIT
- +7 ;
- +8 ;
- AB ;
- +1 ;
- +2 NEW LRX
- +3 ;
- +4 SET LRX=$GET(^LAB(62.06,B,0))
- SET J=$PIECE(LRX,"^",2)
- +5 IF J<1
- QUIT
- +6 ;
- +7 IF '$DATA(LRINT(J))
- QUIT
- +8 IF LRINT(J)'=""
- IF LRINT(J)?."^"
- QUIT
- +9 ;
- +10 DO LINE^LR7OSUM4
- +11 ;
- +12 ; Write name of antibiotic
- +13 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,$$LJ^XLFSTR($PIECE(LRX,U),30,"."))
- +14 ;
- +15 ; Antibiotic display comment from file #62.06
- +16 KILL LRDCOM(0)
- +17 SET LRDCOM=$PIECE(LRX,U,3)
- +18 ; If longer than comment window (GIOM-LRCOMTAB) then format to fit within window.
- +19 IF $LENGTH(LRDCOM)>(GIOM-LRCOMTAB(LRSECT))
- Begin DoDot:1
- +20 NEW J,K,L
- +21 SET J=$LENGTH(LRDCOM)
- SET K=0
- SET L=GIOM-LRCOMTAB(LRSECT)-1
- if L<1
- SET L=1
- +22 FOR
- if LRDCOM=""
- QUIT
- SET K=K+1
- SET LRDCOM(0,K)=$EXTRACT(LRDCOM,1,L)
- SET LRDCOM=$EXTRACT(LRDCOM,L+1,J)
- End DoDot:1
- +23 ;
- +24 DO SIR
- +25 QUIT
- +26 ;
- +27 ;
- BUGHDR ;
- +1 ;
- +2 NEW A,J
- +3 FOR J=1:1
- SET LRBUG=$PIECE(LRSECT(LRSECT),"^",J)
- if LRBUG=""
- QUIT
- Begin DoDot:1
- +4 SET LRORG=$PIECE(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U)
- SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
- +5 IF +$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2."
- QUIT
- +6 DO ORG
- End DoDot:1
- +7 ;
- +8 IF LRFMT="B"
- Begin DoDot:1
- +9 DO LN^LR7OSMZ1
- +10 SET ^TMP("LRC",$JOB,GCNT,0)=""
- +11 FOR J=1:1
- SET A=$PIECE(LRSECT(LRSECT),"^",J)
- if A=""
- QUIT
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
- End DoDot:1
- +12 ;
- +13 DO LN^LR7OSMZ1
- +14 SET ^TMP("LRC",$JOB,GCNT,0)=""
- +15 ;
- +16 FOR J=1:1
- SET A=$PIECE(LRSECT(LRSECT),"^",J)
- if A=""
- QUIT
- Begin DoDot:1
- +17 IF LRFMT'="B"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A),CCNT,":")
- +18 IF LRFMT="B"
- Begin DoDot:2
- +19 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,1),CCNT,"SUSC")
- +20 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,A,2),CCNT,"INTP")
- End DoDot:2
- End DoDot:1
- +21 ;
- +22 QUIT
- +23 ;
- +24 ;
- ORG ;
- +1 ;
- +2 ; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
- +3 ;
- +4 NEW J
- +5 ;
- +6 DO LINE^LR7OSUM4
- +7 ;
- +8 SET ^TMP("LRC",$JOB,GCNT,0)=""
- +9 ;
- +10 IF LRBUG>$PIECE(LRSECT(LRSECT),"^")
- FOR J=1:1
- if $PIECE(LRSECT(LRSECT),"^",J)=LRBUG
- QUIT
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,$PIECE(LRSECT(LRSECT),"^",J)),CCNT,":")
- +11 ;
- +12 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,LRBUG),CCNT,$SELECT(LR2ORMOR:LRBUG(LRBUG)_". ",1:"")_LRORG)
- +13 ;
- +14 QUIT
- +15 ;
- +16 ;
- SIR ; Display the susceptibility results/interpretations
- +1 ;
- +2 NEW II,K
- +3 ;
- +4 FOR K=1:1
- SET II=$PIECE(LRSECT(LRSECT),"^",K)
- if II=""
- QUIT
- Begin DoDot:1
- +5 IF LRFMT="B"
- Begin DoDot:2
- +6 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$PIECE(LRRES(J),U,II))
- +7 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$PIECE(LRINT(J),U,II))
- End DoDot:2
- QUIT
- +8 IF LRFMT="I"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,2),CCNT,$PIECE(LRINT(J),U,II))
- QUIT
- +9 IF LRFMT="R"
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRTAB(LRSECT,II,1),CCNT,$PIECE(LRRES(J),U,II))
- QUIT
- End DoDot:1
- +10 ;
- +11 DO DCOM
- +12 QUIT
- +13 ;
- +14 ;
- DCOM ; Show antibiotic's display comments
- +1 ;
- +2 IF LRDCOM'=""
- Begin DoDot:1
- +3 IF LRCOMTAB(LRSECT)<$X
- IF $LENGTH(LRDCOM)>(GIOM-$X)
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=""
- +4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM)
- End DoDot:1
- +5 ;
- +6 IF $DATA(LRDCOM(0))
- Begin DoDot:1
- +7 NEW J
- +8 SET J=0
- +9 FOR
- SET J=$ORDER(LRDCOM(0,J))
- if 'J
- QUIT
- Begin DoDot:2
- +10 IF J>1
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=""
- +11 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(0,J))
- End DoDot:2
- End DoDot:1
- +12 ;
- +13 IF $DATA(LRDCOM(J))
- Begin DoDot:1
- +14 SET K=0
- SET A=0
- +15 FOR
- SET A=+$ORDER(LRDCOM(J,A))
- if A<1
- QUIT
- Begin DoDot:2
- +16 if '('K&(LRDCOM=""))
- DO LINE^LR7OSUM4
- +17 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCOMTAB(LRSECT),CCNT,LRDCOM(J,A))
- SET K=1
- End DoDot:2
- End DoDot:1
- +18 QUIT