Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRMIPSZ5

LRMIPSZ5.m

Go to the documentation of this file. 
  1. LRMIPSZ5 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, ANTIBIOTICS ;05/24/11  14:37
  1.  ;;5.2;LAB SERVICE;**350,437**;Sep 27, 1994;Build 3
  1.  ;
  1.  Q
  1.  ;
  1. BACT ;
  1.  ; from LRMIPSZ2
  1.  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
  1.  Q:+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,0))<1
  1.  S LRFMT=$P(^LAB(69.9,1,0),U,11),LRFMT=$S(LRFMT="":"I",1:LRFMT)
  1.  ;
  1.  ; Check each organism identified on the specimen.
  1.  ;         A = number of organisms on report that have susceptibilities
  1.  S (A,LRBUG)=0
  1.  F  S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  D
  1.  . I +$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,2))'["2." Q
  1.  . S A=A+1 D CHECK
  1.  ;
  1.  S (LRBN,LRABCNT)=0
  1.  F  S LRBN=+$O(LRRES(LRBN)) Q:LRBN<1  S LRABCNT=LRABCNT+1
  1.  Q:'LRABCNT!($G(LREND))
  1.  ;
  1.  ; Scan result to find longest value, set mininium field width = 4
  1.  S (LRI,LRMAX(1))=0
  1.  F  S LRI=$O(LRRES(LRI)) Q:'LRI  D
  1.  . F I=1:1:A D
  1.  . . S X=$L($P(LRRES(LRI),"^",I))
  1.  . . I X<4 S X=4
  1.  . . I X>$G(LRWIDTH(I,1)) S LRWIDTH(I,1)=X
  1.  . . I X>LRMAX(1) S LRMAX(1)=X
  1.  ;
  1.  ; Scan interpretations to find longest value
  1.  S (LRI,LRMAX(2))=0
  1.  F  S LRI=$O(LRINT(LRI)) Q:'LRI  D
  1.  . F I=1:1:A D
  1.  . . S X=$L($P(LRINT(LRI),"^",I))
  1.  . . I X<4 S X=4
  1.  . . I X>$G(LRWIDTH(I,2)) S LRWIDTH(I,2)=X
  1.  . . I X>LRMAX(2) S LRMAX(2)=X
  1.  ;
  1.  ; Find longest antibiotic display comment to display on report
  1.  S (LRCOMMAX,LRI)=0
  1.  F  S LRI=$O(^LAB(62.06,LRI)) Q:'LRI  D
  1.  . S LRX=$G(^LAB(62.06,LRI,0)) Q:$P(LRX,"^",3)=""
  1.  . I '$P(LRX,"^",2) Q
  1.  . S LRY=0
  1.  . F  S LRY=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRY)) Q:'LRY  D
  1.  . . I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRY,$P(LRX,"^",2))) S X=$L($P(LRX,"^",3)) S:X>LRCOMMAX LRCOMMAX=X
  1.  ;
  1.  ; Check display width so that at least one organsism's values will display when display width is limited
  1.  ; 31 character for antibiotic name, possibly 40 character display comments does not leave much space for actual results.
  1.  I LRCOMMAX>10,IOM'>80 D
  1.  . I LRFMT="B" S X=LRMAX(1)+LRMAX(2)+4
  1.  . I LRFMT="R" S X=LRMAX(1)+2
  1.  . I LRFMT="I" S X=LRMAX(2)+2
  1.  . S X=X+31
  1.  . I (X+LRCOMMAX)>IOM S LRCOMMAX=IOM-X
  1.  ;
  1.  ; Determine tab position (column) of each organism and associated results
  1.  ;  LRSECT will indicate if multiple sections needed when number of organisms, results and display comments exceed right margin.
  1.  S (LRI,LRWIDTH(0,1),LRWIDTH(0,2))=0,LRSECT=1,LRTAB(LRSECT,0)=29
  1.  F  S LRI=$O(LRWIDTH(LRI)) Q:'LRI  D
  1.  . S LRX=LRTAB(LRSECT,LRI-1)
  1.  . I LRFMT="B" D  Q
  1.  . . S LRY=LRX+LRWIDTH(LRI-1,1)+LRWIDTH(LRI-1,2)+4
  1.  . . I (LRY+LRCOMMAX+LRWIDTH(LRI,1)+LRWIDTH(LRI,2))>IOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
  1.  . . S LRTAB(LRSECT,LRI)=LRY
  1.  . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
  1.  . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
  1.  . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
  1.  . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+LRWIDTH(LRI,2)+4
  1.  . I LRFMT="I" D  Q
  1.  . . S LRY=LRX+LRWIDTH(LRI-1,2)+4
  1.  . . I (LRY+LRCOMMAX+LRWIDTH(LRI,2))>IOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
  1.  . . S LRTAB(LRSECT,LRI)=LRY
  1.  . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
  1.  . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
  1.  . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
  1.  . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,2)+2
  1.  . I LRFMT="R" D  Q
  1.  . . S LRY=LRX+LRWIDTH(LRI-1,1)+4
  1.  . . I (LRY+LRCOMMAX+LRWIDTH(LRI,1))>IOM S LRCOMTAB(LRSECT)=LRY,LRY=LRTAB(1,0)+4,LRSECT=LRSECT+1
  1.  . . S LRTAB(LRSECT,LRI)=LRY
  1.  . . S LRTAB(LRSECT,LRI,1)=LRTAB(LRSECT,LRI)
  1.  . . S LRTAB(LRSECT,LRI,2)=LRTAB(LRSECT,LRI)
  1.  . . S LRSECT(LRSECT)=$G(LRSECT(LRSECT))_LRI_"^"
  1.  . . S LRCOMTAB(LRSECT)=LRTAB(LRSECT,LRI)+LRWIDTH(LRI,1)+2
  1.  ;
  1.  D NP Q:LRABORT
  1.  W ! D NP Q:LRABORT
  1.  ;
  1.  W !,"ANTIBIOTIC SUSCEPTIBILITY TEST RESULTS:"
  1.  I $D(^XUSEC("LRLAB",DUZ))&'$D(LRWRDVEW) W "  ('*' indicates display is suppressed)"
  1.  ;
  1.  D NP Q:LRABORT
  1.  ;
  1.  ; If hard copy (LRHC=1)
  1.  I LRHC W ! D NP Q:LRABORT
  1.  ;
  1.  S LRSECT=0
  1.  F  S LRSECT=$O(LRTAB(LRSECT)) Q:'LRSECT  D SECT
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. SECT ; Print antibiotic susceptibility for each section
  1.  ;
  1.  N LRAO
  1.  ;
  1.  D BUGHDR Q:LRABORT
  1.  ;
  1.  ; Display antibiotics by print order
  1.  S LRAO=0
  1.  F  S LRAO=$O(^LAB(62.06,"AO",LRAO)) Q:LRAO<.001!($G(LREND))  D  Q:LRABORT
  1.  . S B=$O(^LAB(62.06,"AO",LRAO,0))
  1.  . I B>0,$D(^LAB(62.06,B,0)) D AB
  1.  ;
  1.  D NP Q:LRABORT
  1.  W !
  1.  D NP
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CHECK ;
  1.  ;
  1.  N B,B1,B2,B3,LRBN,LRFLAG,LR1PASS
  1.  ;
  1.  S LRFLAG=0,LRBN=2
  1.  F  S LRBN=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,LRBN)) Q:LRBN'["2."!($G(LREND))  D
  1.  . S B=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,LRBN),B1=$P(B,U),B2=$P(B,U,2)
  1.  . I B1'="" D FIRST
  1.  ;
  1.  S LRBN=2
  1.  F  S LRBN=+$O(LR1PASS(LRBN)) Q:LRBN<1!($G(LREND))  D
  1.  . S B=LR1PASS(LRBN),B1=$P(B,U),B2=$P(B,U,2),B3=$P(B,U,3)
  1.  . D LAB
  1.  ;
  1.  S LRBUG(A)=LRBUG
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FIRST ;
  1.  ;
  1.  ; If format is 'interpretation only' and no interpretation for this sensitivity then display sensitivity result in it's place.
  1.  I B2="" S B2=$S(LRFMT="I":B1,1:" ")
  1.  ;
  1.  S B3=$P(B,U,3)
  1.  I B2'=" ",$E(B2)'="R","A"[B3 S LRFLAG=1
  1.  S LR1PASS(LRBN)=B1_U_B2_U_B3
  1.  S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,LRBN),U,1,3)=LR1PASS(LRBN)
  1.  Q
  1.  ;
  1.  ;
  1. LAB ;
  1.  I $D(^XUSEC("LRLAB",DUZ)),'$D(LRWRDVEW) D  Q
  1.  . S $P(LRRES(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B1_"*",1:B1)
  1.  . S $P(LRINT(LRBN),U,A)=$S(B3="N"!(B3="R"&LRFLAG):B2_"*",1:B2)
  1.  ;
  1.  I B3=""!(B3="A")!(B3="R"&'LRFLAG) S $P(LRRES(LRBN),U,A)=B1,$P(LRINT(LRBN),U,A)=B2
  1.  Q
  1.  ;
  1.  ;
  1. AB ;
  1.  N PGNUM,LRX
  1.  Q:$G(LREND)
  1.  S LRX=$G(^LAB(62.06,B,0)),J=$P(LRX,"^",2)
  1.  I J<1 Q
  1.  D NP Q:LRABORT
  1.  I '$D(LRINT(J)) Q
  1.  I LRINT(J)'="",LRINT(J)?."^" Q
  1.  D NP Q:LRABORT
  1.  ;
  1.  ; Write name of antibiotic
  1.  W !,$$LJ^XLFSTR($P(LRX,U),30,".")
  1.  ;
  1.  ; Antibiotic display comment from file #62.06
  1.  K LRDCOM(0)
  1.  S LRDCOM=$P(LRX,U,3)
  1.  ; If longer than comment window (IOM-LRCOMTAB) then format to fit within window.
  1.  I $L(LRDCOM)>(IOM-LRCOMTAB(LRSECT)) D
  1.  . N J,K,L
  1.  . S J=$L(LRDCOM),K=0,L=IOM-LRCOMTAB(LRSECT)-1 S:L<1 L=1
  1.  . F  Q:LRDCOM=""  S K=K+1,LRDCOM(0,K)=$E(LRDCOM,1,L),LRDCOM=$E(LRDCOM,L+1,J)
  1.  ;
  1.  D SIR
  1.  ;
  1.  S PGNUM=LRPG
  1.  D NP Q:LRABORT
  1.  I LRPG>PGNUM D BUGHDR D NP
  1.  Q
  1.  ;
  1.  ;
  1. BUGHDR ;
  1.  ;
  1.  N A,J
  1.  F J=1:1 S LRBUG=$P(LRSECT(LRSECT),"^",J) Q:LRBUG=""!($G(LREND))  D
  1.  . S LRORG=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),0),U),LRORG=$P(^LAB(61.2,LRORG,0),U)
  1.  . I +$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG(LRBUG),2))'["2." Q
  1.  . D ORG
  1.  ;
  1.  I LRFMT="B" D
  1.  . W !
  1.  . F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A=""  W ?LRTAB(LRSECT,A),":"
  1.  ;
  1.  D NP Q:LRABORT
  1.  W !
  1.  D NP Q:LRABORT
  1.  ;
  1.  F J=1:1 S A=$P(LRSECT(LRSECT),"^",J) Q:A=""  D
  1.  . I LRFMT'="B" W ?LRTAB(LRSECT,A),":"
  1.  . I LRFMT="B" W ?LRTAB(LRSECT,A,1),"SUSC",?LRTAB(LRSECT,A,2),"INTP"
  1.  ;
  1.  D NP
  1.  Q
  1.  ;
  1.  ;
  1. ORG ;
  1.  ;
  1.  ; LR2ORMOR flag indicating 2 or more organsims on report - set in LRMIPSZ2.
  1.  ;
  1.  N J
  1.  W !
  1.  D NP Q:LRABORT
  1.  ;
  1.  I LRBUG>$P(LRSECT(LRSECT),"^") F J=1:1 Q:$P(LRSECT(LRSECT),"^",J)=LRBUG  W ?LRTAB(LRSECT,$P(LRSECT(LRSECT),"^",J)),":"
  1.  ;
  1.  W ?LRTAB(LRSECT,LRBUG),$S(LR2ORMOR:LRBUG(LRBUG)_". ",1:""),LRORG
  1.  D NP
  1.  Q
  1.  ;
  1.  ;
  1. SIR ; Display the susceptibility results/interpretations
  1.  ;
  1.  N II,K
  1.  ;
  1.  F K=1:1 S II=$P(LRSECT(LRSECT),"^",K) Q:II=""  D
  1.  . I LRFMT="B" D  Q
  1.  . . W ?LRTAB(LRSECT,II,1),$P($G(LRRES(J)),U,II)
  1.  . . W ?LRTAB(LRSECT,II,2),$P(LRINT(J),U,II),"  "
  1.  . I LRFMT="I" W ?LRTAB(LRSECT,II,2),$P(LRINT(J),U,II)," " Q
  1.  . I LRFMT="R" W ?LRTAB(LRSECT,II,1),$P(LRRES(J),U,II)," " Q
  1.  ;
  1.  D DCOM
  1.  Q
  1.  ;
  1.  ;
  1. DCOM ;
  1.  N A,K
  1.  ;
  1.  I LRDCOM'="" D
  1.  . I LRCOMTAB(LRSECT)<$X,$L(LRDCOM)>(IOM-$X) W !
  1.  . W ?LRCOMTAB(LRSECT),LRDCOM
  1.  ;
  1.  I $D(LRDCOM(0)) D
  1.  . N J
  1.  . S J=0
  1.  . F  S J=$O(LRDCOM(0,J)) Q:'J  W:J'=1 ! W ?LRCOMTAB(LRSECT),LRDCOM(0,J)
  1.  ;
  1.  I $D(LRDCOM(J)) D
  1.  . S K=0,A=0
  1.  . F  S A=+$O(LRDCOM(J,A)) Q:A<1  D
  1.  . . I '('K&(LRDCOM="")) W !
  1.  . . W ?LRCOMTAB(LRSECT),LRDCOM(J,A) S K=1
  1.  Q
  1.  ;
  1.  ;
  1. NHDR ;
  1.  F X=1:1 W ! Q:$Y>(IOSL-LRFLIP)
  1.  Q:$G(LREND)  I 'LRHC D FH^LRMIPSU Q
  1.  W ! F X=1:1:IOM W "-"
  1.  W !,"PATIENT'S IDENTIFICATION",?60,"MICROBIOLOGY REPORT"
  1.  W !!,PNM,?$X+3,SSN,?$X+3,SEX,?$X+3,"DOB: ",DOB,"  WARD: ",LRWRD,!,"ADM: ",LRADM,"   ADM DX: ",LRADX
  1.  S LRPG=LRPG+1
  1.  W @IOF,!,?18,"MICROBIOLOGY LAB ",$$INS^LRU
  1.  W ?$X+10,$$HTE^XLFDT($H,"D"),!
  1.  F X=1:1:IOM W "-"
  1.  W !,"ACCESSION: ",LRACC,?25,"TAKEN:",LRTK,?52,"RECEIVED:",LRRC
  1.  Q
  1.  ;
  1.  ;
  1. NP ;
  1.  ; Convenience method
  1.  D NP^LRMIPSZ1
  1.  Q