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

LR7OSMZ1.m

Go to the documentation of this file. 
  1. LR7OSMZ1 ;DALOI/JMC - Silent Micro rpt Cont. ;Mar 05, 2019@13:04:42
  1.  ;;5.2;LAB SERVICE;**121,244,350,520,536**;Sep 27, 1994;Build 18
  1.  ;
  1. EN ; from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1
  1.  S LRSPEC=$P(LRLLT,U,5)
  1.  I LRONESPC'="",LRSPEC'=LRONESPC Q
  1.  ;
  1.  N GIOM
  1.  S GIOM=$G(LRGIOM)
  1.  I GIOM="" D
  1.  . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
  1.  . I GIOM="" S GIOM=80
  1.  ;
  1.  D RPT
  1.  K %,A8,A,AB,B,B1,B2,B3,C,IA,LR1PASS,LR2ORMOR,LRABCNT,LRACNT,LRAO,LRADM,LRADX,LRAFS,LRAMT,LRAX,LRBN,LRBRR,LRBUG,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFMT,LRGRM,LRIFN,LRINT,LRPATLOC,LRMYC,LRNS,LRNUM
  1.  K LRORG,LRPAR,LRPC,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST,LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,N
  1.  Q
  1.  ;
  1.  ;
  1. RPT ;
  1.  ;
  1.  N J,LRTSTS,LRTS,LRTESTCOMPLE,LRX,LRY,LRDISP
  1.  ;
  1.  S:'$D(LRSB) LRSB=0
  1.  S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRPATLOC=$P(LRLLT,U,8)
  1.  S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"")
  1.  S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:""),Y=LRTK
  1.  D D^LRU
  1.  S LRTK=Y,Y=LRRC
  1.  D D^LRU
  1.  S LRRC=Y,X=$P(LRLLT,U,7)
  1.  D DOC^LRX
  1.  ;
  1.  K ^TMP("LR",$J,"T"),LRTSTS
  1.  ;
  1.  S (LRBRR,LRTESTCOMPLE)=0
  1.  F  S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1  D EN1
  1.  I 'LRPRINT,LRONETST Q
  1.  S LRPG=0
  1.  D HDR^LR7OSMZU
  1.  Q:LREND
  1.  ;
  1.  I $D(^TMP("LR",$J,"T")) D
  1.  . D LINE^LR7OSUM4,LN
  1.  . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(2,CCNT,"Test(s) ordered:")
  1.  . S J=""
  1.  . F  S J=$O(^TMP("LR",$J,"T",J)) Q:J=""  S X=^(J) D
  1.  . . S LRX=$P(X,"^")
  1.  . . I LRTESTCOMPLE S LRX=$$LJ^XLFSTR(LRX,30,".")
  1.  . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(19,CCNT,LRX)
  1.  . . S:'$D(^TMP("LRT",$J,$P(X,"^"))) ^($P(X,"^"))="MICROBIOLOGY"_"^"_GCNT
  1.  . . I '$P(X,U,2) D LN S ^TMP("LRC",$J,GCNT,0)="" Q
  1.  . . S Y=$P(X,U,2)
  1.  . . ; LR*5.2*520 and LR*5.2*536
  1.  . . S LRDISP=$P(X,U,3)
  1.  . . D D^LRU S LRY=$S(LRDISP["Not Performed":"canceled: ",1:"completed: ")_Y
  1.  . . I (19+$L(LRX)+$L(LRY))>GIOM D LN S ^TMP("LRC",$J,GCNT,0)=""
  1.  . . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(50,CCNT,LRY)
  1.  . . D LN S ^TMP("LRC",$J,GCNT,0)=""
  1.  ;
  1.  K ^TMP("LR",$J,"T"),LRTSTS
  1.  ;
  1.  I $D(^LR(LRDFN,"MI",LRIDT,14)) D ANTI^LR7OSMZ2,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,1)) D BACT^LR7OSMZ2,REFS^LR7OSMZU,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,31)) D STER^LR7OSMZ3,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,5)) D PARA^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,16)) D VIR^LR7OSMZ3,REFS^LR7OSMZU,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,11)) D TB^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4
  1.  I $D(^LR(LRDFN,"MI",LRIDT,8)) D FUNG^LR7OSMZ4,REFS^LR7OSMZU,LINE^LR7OSUM4
  1.  ;
  1.  ; List performing labs
  1.  D PPL(LRDFN,"MI",LRIDT)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. EN1 ;
  1.  ; LR*5.2*520 Set disposition to LRDISP
  1.  S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5),LRDISP=$P(^(0),U,6)
  1.  Q:'$L($P($G(^LAB(60,LRTS,0)),U,3))
  1.  I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q
  1.  ;
  1.  ; Set flag that at least one test is completed
  1.  I LRTS(1) S LRTESTCOMPLE=1
  1.  ;
  1.  S:LRTS=LRONETST LRPRINT=1
  1.  S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test"),^TMP("LR",$J,"T",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)_U_LRDISP
  1.  Q
  1.  ;
  1.  ;
  1. LN ;Increment counter
  1.  S GCNT=GCNT+1,CCNT=1
  1.  Q
  1.  ;
  1.  ;
  1. PPL(LRDFN,LRSS,LRIDT) ; Print any performing laboratories
  1.  ; Call with LRDFN = file #63 IEN
  1.  ;            LRSS = File #63 subscript
  1.  ;           LRIDT = file #63 specimen inverse date/time
  1.  ;
  1.  N LRPL,LRI,LRX
  1.  ;
  1.  D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,0)
  1.  I $G(LRPL)<1 Q
  1.  ;
  1.  D LN S LRX="=--",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX))
  1.  D LN S ^TMP("LRC",$J,GCNT,0)="Performing Laboratory:"
  1.  ;
  1.  S LRI=0
  1.  F  S LRI=$O(LRPL(LRI)) Q:'LRI  D LN S ^TMP("LRC",$J,GCNT,0)=LRPL(LRI)
  1.  D LN S ^TMP("LRC",$J,GCNT,0)=""
  1.  ;
  1.  Q