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

LRMIPSZ2.m

Go to the documentation of this file. 
  1. LRMIPSZ2 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;Jul 15, 2021@13:13
  1.  ;;5.2;LAB SERVICE;**388,350,427,547**;Sep 27, 1994;Build 10
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. ANTI ;
  1.  ; from LRMIPSZ1
  1.  N B,I
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,0)) D
  1.  . W !!,?28,"Antibiotic Level(s):"
  1.  . W !,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
  1.  . S B=0
  1.  . F  S B=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B)) Q:B<1  D
  1.  . . W !,$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$P(^(0),U,2))
  1.  Q
  1.  ;
  1. MES ;LR*5.2*547: Display informational message if accession/test is currently being edited.
  1.  Q:'$G(LR7SB)
  1.  N LR7AREA
  1.  S LR7AREA=$S(LR7SB=1:"Bacteriology",LR7SB=5:"Parasitology",LR7SB=8:"Mycology",LR7SB=11:"Mycobacteriology",1:"Virology")
  1.  Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB))
  1.  W !,?22,"**** ATTENTION ****",!,?10,"The "_LR7AREA_" Report is being edited",!,?10,"by tech code ",^XTMP("LRMICRO EDIT",LRDFN,LRIDT,LR7SB)
  1.  W " and current results",!,?10,"may not be visible until approved.",!
  1.  Q
  1.  ;
  1. BACT ;
  1.  ; from LRMIPSZ1
  1.  I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U)="",'$G(LRLABKY) D  Q:'$D(LRWRDVEW)  Q:LRSB'=1
  1.  . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,1))
  1.  . ;LR*5.2*547: Display informational message if accession/test is currently being edited
  1.  . ;            and results had previously been verified.
  1.  . N LR7SB S LR7SB=1
  1.  . D MES
  1.  D BUG
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D GRAM
  1.  . D NP
  1.  Q:LRABORT
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D BSMEAR
  1.  . D NP
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D  Q:LRABORT  ;
  1.  . D NP Q:LRABORT
  1.  . D BRMK Q:LREND
  1.  . D NP Q:LRABORT
  1.  . D BACT^LRMIPSZ5
  1.  . D NP
  1.  ;
  1.  I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4)) D  Q:LRABORT  ;
  1.  . N B,I
  1.  . D NP Q:LRABORT
  1.  . I LRHC W ! D NP Q:LRABORT
  1.  . W !,"Bacteriology Remark(s):"
  1.  . D NP Q:LRABORT
  1.  . S B=0
  1.  . F I=0:0 S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B)) Q:B<1  W !,?3,^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B,0) D NP Q:LRABORT
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. BUG ;
  1.  N LRNS,LRTUS,LRUS,X
  1.  ;
  1.  S X=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),LRTUS=$P(X,U,2),DZ=$P(X,U,3),LRUS=$P(X,U,6),LRNS=$P(X,U,5),Y=$P(X,U)
  1.  ;
  1.  D D^LRU
  1.  D NP Q:LRABORT
  1.  W:LRHC !
  1.  D NP Q:LRABORT
  1.  W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_"   TECH CODE: "_DZ
  1.  D NP Q:LRABORT
  1.  S LRPRE=19
  1.  D PRE^LRMIPSU
  1.  I LRUS'="" D NP Q:LRABORT  W !,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS) D NP Q:LRABORT  W:LRHC ! D NP Q:LRABORT
  1.  I LRNS'="" D NP Q:LRABORT  W !,"SPUTUM SCREEN:  ",LRNS D NP Q:LRABORT  W:LRHC ! D NP Q:LRABORT
  1.  Q
  1.  ;
  1.  ;
  1. GRAM ;
  1.  N CNT
  1.  ;
  1.  D NP Q:LRABORT
  1.  W !,"GRAM STAIN:"
  1.  S (CNT,LRGRM)=0
  1.  F  S LRGRM=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1  S CNT=CNT+1 W:CNT>1 ! W ?12,^(LRGRM,0) D NP Q:LRABORT
  1.  I LRHC W !
  1.  D NP
  1.  Q
  1.  ;
  1.  ;
  1. BSMEAR ;
  1.  W !,"BACTERIOLOGY SMEAR/PREP:",!
  1.  S LRMYC=0
  1.  F  S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1  W ?5,^(LRMYC,0),!
  1.  Q
  1.  ;
  1.  ;
  1. BRMK ;
  1.  ; also called from T51^LRMIV1
  1.  N LRBLDTMP
  1.  S LRBLDTMP=0
  1.  I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D  ;
  1.  . S LRBLDTMP=1
  1.  . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)=^LR(LRDFN,"MI",LRIDT,3)
  1.  ;
  1.  S (LRBUG,LR2ORMOR)=0
  1.  F LRAX=1,2 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  S:LRAX=2 LR2ORMOR=1
  1.  I LRAX'=1 S (LRBUG,LRTSTS)=0 F LRAX=1:1 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  D LST
  1.  ; delete ^TMP if built just for this entrypoint
  1.  I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)
  1.  Q
  1.  ;
  1.  ;
  1. LST ;
  1.  ;
  1.  N LRX
  1.  S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,0)
  1.  S (LRBUG(LRAX),LRORG)=$P(LRX,U),LRQU=$P(LRX,U,2),LRSSD=$P(LRX,U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
  1.  ;
  1.  I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
  1.  D NP Q:LRABORT
  1.  W:LRHC !
  1.  I LRAX=1 W !,"CULTURE RESULTS:"
  1.  E  W !
  1.  W ?17,$S(LR2ORMOR:$J(LRBUG,2)_". ",1:" "),LRORG
  1.  ;
  1.  ; Display quantity/colony count
  1.  I LRQU'="" D
  1.  . S LRX=" - Quantity: "_LRQU
  1.  . I (IOM-$X-1)<$L(LRX) W !,?21
  1.  . W LRX
  1.  ;
  1.  I LRSSD D FH^LRMIPSU Q:LREND  D SSD W:LRHC !
  1.  S:$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1
  1.  I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,0)) D MIC
  1.  D CMNT
  1.  Q
  1.  ;
  1.  ;
  1. SSD ;
  1.  D NP Q:LRABORT
  1.  W !
  1.  ;
  1.  D NP Q:LRABORT
  1.  S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
  1.  ;
  1.  I LRSIC1'="" D
  1.  . W !,?20,"SIT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSIC1
  1.  . D NP
  1.  Q:LRABORT
  1.  ;
  1.  I LRSBC1'="" D
  1.  . W !,?20,"SBT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSBC1
  1.  . D NP
  1.  Q:LRABORT
  1.  ;
  1.  I LRSIC2'="" D
  1.  . W !,?20,"SIT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSIC2
  1.  . D NP
  1.  Q:LRABORT
  1.  ;
  1.  I LRSBC2'="" D
  1.  . W !,?20,"SBT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSBC2
  1.  . D NP
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. MIC ;
  1.  ;
  1.  N B
  1.  W !,?21,"Antibiotic"
  1.  ;
  1.  ; If data in 2/3rd pieces then print header
  1.  S B=0
  1.  F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  I $P(^(B,0),U,2,3)'="" W ?38,"MIC (ug/ml)",?53,"MBC (ug/ml)" Q
  1.  ;
  1.  ; Print results
  1.  S B=0
  1.  F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  W !,?21,$P(^(B,0),U),?38,$J($P(^(0),U,2),7),?53,$J($P(^(0),U,3),7)
  1.  Q
  1.  ;
  1.  ;
  1. CMNT ;
  1.  N A,LRX,X,DIWL,DIWR,DIWF,LRIDX
  1.  ;
  1.  S LRPC=0,DIWL=31,DIWR=IOM,DIWF="|"
  1.  F A=0:1 S LRPC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1  D  Q:LRABORT
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0),X=LRX
  1.  . K ^UTILITY($J,"W")
  1.  . D ^DIWP
  1.  . I A=0,$D(^UTILITY($J,"W",31,1,0)) D
  1.  . . W !,?21,"Comment: "_^UTILITY($J,"W",31,1,0)
  1.  . . K ^UTILITY($J,"W",31,1,0)
  1.  . D NP Q:LRABORT
  1.  . S LRIDX=0
  1.  . F  S LRIDX=$O(^UTILITY($J,"W",31,LRIDX)) Q:'LRIDX  D
  1.  . . Q:'$D(^UTILITY($J,"W",31,LRIDX,0))
  1.  . . W !,?21,"         "_^UTILITY($J,"W",31,LRIDX,0)
  1.  . . D NP
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ;
  1.  ;
  1. NP ;
  1.  ; Convenience method
  1.  D NP^LRMIPSZ1
  1.  Q