LR7OSMZ0 ;slc/dcm - Silent Micro rpt ;8/11/97
;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
EN1 ;from
S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRAD=$E(LRLLT)_$P(LRACC," ",2)_"0000",X=$P(LRACC," "),DIC=68,DIC(0)="M"
I $L(X) D ^DIC S LRAA=+Y,LRAN=+$P(LRACC," ",3),LRCMNT=$S($D(^LR(LRDFN,"MI",LRIDT,99)):^(99),1:""),LRPG=0 D EN^LR7OSMZ1 Q:LREND
Q
EN(DFN) ;Process Microbiology entries listed in ^TMP("LRRR",$J,DFN,"MI",LRIDT,1)
;Return formated report in ^TMP("LRC",$J)
Q:'$D(^TMP("LRRR",$J,+$G(DFN),"MI"))
N LBL,LCNT,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDFN,LRDPF,LRIDT,LRJ02,LRLLT,LRPG,LRSB
N LRONESPC,LREND,LRONETST,GCNT,GIOM,LREND,CCNT,CT1,COUNT,LRIN,SEX
K ^TMP("LRC",$J)
S (LRONETST,LRONESPC)="",CCNT=1,(LREND,GCNT)=0,GIOSL=999999,GIOM=80
Q:'$G(DFN)
S LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN
S LRDPF="2^DPT(",SEX=$P($G(@("^"_$P(LRDPF,"^",2)_+LRDFN_",0)")),"^",2),LRIDT=0
F S LRIDT=$O(^TMP("LRRR",$J,DFN,"MI",LRIDT)) Q:LRIDT<1 D
. N DFN
. D EN1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSMZ0 986 printed Nov 22, 2024@17:15:37 Page 2
LR7OSMZ0 ;slc/dcm - Silent Micro rpt ;8/11/97
+1 ;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
EN1 ;from
+1 SET LRLLT=^LR(LRDFN,"MI",LRIDT,0)
SET LRACC=$PIECE(LRLLT,U,6)
SET LRAD=$EXTRACT(LRLLT)_$PIECE(LRACC," ",2)_"0000"
SET X=$PIECE(LRACC," ")
SET DIC=68
SET DIC(0)="M"
+2 IF $LENGTH(X)
DO ^DIC
SET LRAA=+Y
SET LRAN=+$PIECE(LRACC," ",3)
SET LRCMNT=$SELECT($DATA(^LR(LRDFN,"MI",LRIDT,99)):^(99),1:"")
SET LRPG=0
DO EN^LR7OSMZ1
if LREND
QUIT
+3 QUIT
EN(DFN) ;Process Microbiology entries listed in ^TMP("LRRR",$J,DFN,"MI",LRIDT,1)
+1 ;Return formated report in ^TMP("LRC",$J)
+2 if '$DATA(^TMP("LRRR",$JOB,+$GET(DFN),"MI"))
QUIT
+3 NEW LBL,LCNT,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDFN,LRDPF,LRIDT,LRJ02,LRLLT,LRPG,LRSB
+4 NEW LRONESPC,LREND,LRONETST,GCNT,GIOM,LREND,CCNT,CT1,COUNT,LRIN,SEX
+5 KILL ^TMP("LRC",$JOB)
+6 SET (LRONETST,LRONESPC)=""
SET CCNT=1
SET (LREND,GCNT)=0
SET GIOSL=999999
SET GIOM=80
+7 if '$GET(DFN)
QUIT
+8 SET LRDFN=$$LRDFN^LR7OR1(DFN)
+9 if 'LRDFN
QUIT
+10 SET LRDPF="2^DPT("
SET SEX=$PIECE($GET(@("^"_$PIECE(LRDPF,"^",2)_+LRDFN_",0)")),"^",2)
SET LRIDT=0
+11 FOR
SET LRIDT=$ORDER(^TMP("LRRR",$JOB,DFN,"MI",LRIDT))
if LRIDT<1
QUIT
Begin DoDot:1
+12 NEW DFN
+13 DO EN1
End DoDot:1
+14 QUIT