- LR7OSMZ1 ;slc/dcm - Silent Micro rpt Cont. ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
- EN ;from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1
- S LRSPEC=$P(LRLLT,U,5)
- I LRONESPC'="",LRSPEC'=LRONESPC Q
- D RPT
- 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
- 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
- Q
- RPT ;
- S:'$D(LRSB) LRSB=0
- S LRPRINT=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1),LRPATLOC=$P(LRLLT,U,8)
- S LRCS=$S($D(^LAB(62,+$P(LRLLT,U,11),0)):$P(^(0),U),1:"")
- S LRTK=$P(LRLLT,U),LRRC=$P(LRLLT,U,10),LRST=$S(LRSPEC:$P(^LAB(61,LRSPEC,0),U),1:""),Y=LRTK
- D D^LRU
- S LRTK=Y,Y=LRRC
- D D^LRU
- S LRRC=Y,X=$P(LRLLT,U,7)
- D DOC^LRX
- K ^TMP("LR",$J,"T"),LRTSTS
- S LRBRR=0
- F S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR<1 D EN1
- I 'LRPRINT,LRONETST Q
- S LRPG=0
- D HDR^LR7OSMZU
- Q:LREND
- I $D(^TMP("LR",$J,"T")) D LINE^LR7OSUM4,LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,"Test(s) ordered:") S J="" F S J=$O(^TMP("LR",$J,"T",J)) Q:J="" S X=^(J) D
- . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(23,CCNT,$P(X,U)),Y=$P(X,U,2)
- . D:$L(Y) D^LRU
- . S:'$D(^TMP("LRT",$J,$P(X,"^"))) ^($P(X,"^"))="MICROBIOLOGY"_"^"_GCNT
- . S:$L(Y) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(43,CCNT," completed: "_Y)
- . D LN
- . S ^TMP("LRC",$J,GCNT,0)=""
- K ^TMP("LR",$J,"T"),LRTSTS
- I $D(^LR(LRDFN,"MI",LRIDT,14)) D FH^LR7OSMZU Q:LREND D ANTI^LR7OSMZ2
- I $D(^LR(LRDFN,"MI",LRIDT,1)) D FH^LR7OSMZU Q:LREND D BACT^LR7OSMZ2 Q:LREND D REFS^LR7OSMZU Q:LREND
- I $D(^LR(LRDFN,"MI",LRIDT,31)) D FH^LR7OSMZU Q:LREND D STER^LR7OSMZ3
- I $D(^LR(LRDFN,"MI",LRIDT,5)) D FH^LR7OSMZU Q:LREND D PARA^LR7OSMZ3,REFS^LR7OSMZU Q:LREND
- I $D(^LR(LRDFN,"MI",LRIDT,16)) D FH^LR7OSMZU Q:LREND D VIR^LR7OSMZ3,REFS^LR7OSMZU Q:LREND
- I $D(^LR(LRDFN,"MI",LRIDT,11)) D FH^LR7OSMZU Q:LREND D TB^LR7OSMZ4,REFS^LR7OSMZU Q:LREND
- I $D(^LR(LRDFN,"MI",LRIDT,8)) D FH^LR7OSMZU Q:LREND D FUNG^LR7OSMZ4,REFS^LR7OSMZU Q:LREND
- Q
- EN1 ;
- S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5)
- Q:'$L($P($G(^LAB(60,LRTS,0)),U,3))
- I '$D(LRLABKY),"BO"'[$P($G(^LAB(60,LRTS,0)),U,3) Q
- S:LRTS=LRONETST LRPRINT=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)
- Q
- LN ;Increment counter
- S GCNT=GCNT+1,CCNT=1
- Q
- LR7OSMZ1 ;slc/dcm - Silent Micro rpt Cont. ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
- EN ;from LRMINEW2, LRMIPC, LRMIPLOG, LR7OSMZ, LRMIVER1
- +1 SET LRSPEC=$PIECE(LRLLT,U,5)
- +2 IF LRONESPC'=""
- IF LRSPEC'=LRONESPC
- QUIT
- +3 DO RPT
- +4 KILL %,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
- +5 KILL 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
- +6 QUIT
- RPT ;
- +1 IF '$DATA(LRSB)
- SET LRSB=0
- +2 SET LRPRINT=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4)):"",1:1)
- SET LRPATLOC=$PIECE(LRLLT,U,8)
- +3 SET LRCS=$SELECT($DATA(^LAB(62,+$PIECE(LRLLT,U,11),0)):$PIECE(^(0),U),1:"")
- +4 SET LRTK=$PIECE(LRLLT,U)
- SET LRRC=$PIECE(LRLLT,U,10)
- SET LRST=$SELECT(LRSPEC:$PIECE(^LAB(61,LRSPEC,0),U),1:"")
- SET Y=LRTK
- +5 DO D^LRU
- +6 SET LRTK=Y
- SET Y=LRRC
- +7 DO D^LRU
- +8 SET LRRC=Y
- SET X=$PIECE(LRLLT,U,7)
- +9 DO DOC^LRX
- +10 KILL ^TMP("LR",$JOB,"T"),LRTSTS
- +11 SET LRBRR=0
- +12 FOR
- SET LRBRR=+$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR))
- IF LRBRR<1
- QUIT
- DO EN1
- +13 IF 'LRPRINT
- IF LRONETST
- QUIT
- +14 SET LRPG=0
- +15 DO HDR^LR7OSMZU
- +16 IF LREND
- QUIT
- +17 IF $DATA(^TMP("LR",$JOB,"T"))
- DO LINE^LR7OSUM4
- DO LN
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(5,CCNT,"Test(s) ordered:")
- SET J=""
- FOR
- SET J=$ORDER(^TMP("LR",$JOB,"T",J))
- IF J=""
- QUIT
- SET X=^(J)
- Begin DoDot:1
- +18 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(23,CCNT,$PIECE(X,U))
- SET Y=$PIECE(X,U,2)
- +19 IF $LENGTH(Y)
- DO D^LRU
- +20 IF '$DATA(^TMP("LRT",$JOB,$PIECE(X,"^")))
- SET ^($PIECE(X,"^"))="MICROBIOLOGY"_"^"_GCNT
- +21 IF $LENGTH(Y)
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(43,CCNT," completed: "_Y)
- +22 DO LN
- +23 SET ^TMP("LRC",$JOB,GCNT,0)=""
- End DoDot:1
- +24 KILL ^TMP("LR",$JOB,"T"),LRTSTS
- +25 IF $DATA(^LR(LRDFN,"MI",LRIDT,14))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO ANTI^LR7OSMZ2
- +26 IF $DATA(^LR(LRDFN,"MI",LRIDT,1))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO BACT^LR7OSMZ2
- IF LREND
- QUIT
- DO REFS^LR7OSMZU
- IF LREND
- QUIT
- +27 IF $DATA(^LR(LRDFN,"MI",LRIDT,31))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO STER^LR7OSMZ3
- +28 IF $DATA(^LR(LRDFN,"MI",LRIDT,5))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO PARA^LR7OSMZ3
- DO REFS^LR7OSMZU
- IF LREND
- QUIT
- +29 IF $DATA(^LR(LRDFN,"MI",LRIDT,16))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO VIR^LR7OSMZ3
- DO REFS^LR7OSMZU
- IF LREND
- QUIT
- +30 IF $DATA(^LR(LRDFN,"MI",LRIDT,11))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO TB^LR7OSMZ4
- DO REFS^LR7OSMZU
- IF LREND
- QUIT
- +31 IF $DATA(^LR(LRDFN,"MI",LRIDT,8))
- DO FH^LR7OSMZU
- IF LREND
- QUIT
- DO FUNG^LR7OSMZ4
- DO REFS^LR7OSMZU
- IF LREND
- QUIT
- +32 QUIT
- EN1 ;
- +1 SET LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0)
- SET LRTS(1)=$PIECE(^(0),U,5)
- +2 IF '$LENGTH($PIECE($GET(^LAB(60,LRTS,0)),U,3))
- QUIT
- +3 IF '$DATA(LRLABKY)
- IF "BO"'[$PIECE($GET(^LAB(60,LRTS,0)),U,3)
- QUIT
- +4 IF LRTS=LRONETST
- SET LRPRINT=1
- +5 SET LRTSTS=$SELECT($DATA(^LAB(60,LRTS,0)):$PIECE(^(0),U),1:"deleted test")
- SET ^TMP("LR",$JOB,"T",$SELECT($DATA(^LAB(60,LRTS,.1)):$PIECE(^(.1),U,6),1:"")_","_LRBRR)=LRTSTS_U_LRTS(1)
- +6 QUIT
- LN ;Increment counter
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT
