LRMITSR ;SLC/STAFF - MICRO TREND REPORT ;10/17/92 22:52
;;5.2;LAB SERVICE;**96,257**;Sep 27, 1994
; from LRMITSP
; report may be stopped by stopping task
;
D REPORT I LREND W !!,"Report has been stopped."
W @IOF K LRABRV,LRACC,LRCDATE,LRCNT,LRCOLS,LRDN,LRGPN,LRGPNM,LRGPV,LRHDR,LRHDR1,LRHDRT,LRLINE,LRLINE1,LRN,LRN1,LRN2,LRN3,LRNM
K LRORGN,LRORGNM,LRPAGE,LRPATN,LRPATNM,LRPATNUM,LRPLOS,LRSPACE,LRSPECN,LRSPECNM,LRSTATUS,LRSUBN,LRSUSC,LRTCNT,LRTYPE,LRX
Q
REPORT D ^LRMITSRS
I $D(LRM("O")) D Q:LREND
.S LRPAGE=0,LRPATNUM=+$G(^TMP($J,"O")),LRTYPE="O" D ^LRMITSRH Q:LREND
.S LRORGNM="" F S LRORGNM=$O(^TMP($J,LRTYPE,LRORGNM)) Q:LRORGNM="" D Q:LREND
..S LRORGN=0 F S LRORGN=$O(^TMP($J,LRTYPE,LRORGNM,LRORGN)) Q:LRORGN<1 S LRN1=$G(^(LRORGN,LRORGNM,LRORGN)) D Q:LREND
...I $D(LRM(LRTYPE,"S")),'$D(LRM(LRTYPE,"S",LRORGN)) Q
...D RESULTS
S LRTYPE="" F S LRTYPE=$O(LRM(LRTYPE)) Q:LRTYPE="" I LRTYPE'="O" D Q:LREND
.S LRPAGE=0,LRPATNUM=+$G(^TMP($J,LRTYPE)) D ^LRMITSRH Q:LREND
.S LRGPNM="" F S LRGPNM=$O(^TMP($J,LRTYPE,LRGPNM)) Q:LRGPNM="" D Q:LREND
..S LRGPN="" F S LRGPN=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN)) Q:LRGPN="" S LRGPV=+^(LRGPN) D Q:LREND
...I $D(LRM(LRTYPE,"S")),'$D(LRM(LRTYPE,"S",LRGPN)) Q
...D LCHECK Q:LREND W !,LRGPNM," (",+LRGPV," isolates)",!,"---------------"
...S LRORGNM="" F S LRORGNM=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN,LRORGNM)) Q:LRORGNM="" D Q:LREND
....S LRORGN=0 F S LRORGN=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN,LRORGNM,LRORGN)) Q:LRORGN<1 S LRN1=^(LRORGN) D RESULTS Q:LREND
Q
RESULTS D LCHECK Q:LREND W !,$S($L(LRORGNM)<34:$E(LRORGNM,5,34),1:$P(^LAB(61.2,LRORGN,0),U)) S LROTYPE=$E($P(LRORGNM,"(",2))
S LRX=^TMP($J,LRN1,"C") D LCHECK Q:LREND W !,"(",+LRX," counted, ",+$P(LRX,U,2)," merged, ",+$P(LRX,U,3)," not tested)"
I LROTYPE="B" D Q:LREND
.S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
.S LRLINE="% sus",LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
..Q:LRABRV=""
..S (LRSUSC,LRX)=$G(^TMP($J,LRN1,"C",LRABRV)) I LRX S LRSUSC=$J($P(LRX,U,2)/LRX*100,0,0)
..S LRLINE=LRLINE_"|"_$J(LRSUSC,3)
.S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
.S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
.S LRLINE="# ctd",LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
..Q:LRABRV=""
..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
..S (LRTCNT,LRX)=$G(^TMP($J,LRN1,"C",LRABRV)) I LRX S LRTCNT=+LRX
..S LRLINE=LRLINE_"|"_$J(LRTCNT,3)
.S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
; detailed report
Q:'LRDETAIL
S LRPATNM="" F S LRPATNM=$O(^TMP($J,LRN1,"P",LRPATNM)) Q:LRPATNM="" D Q:LREND
.S LRPATN=0 F S LRPATN=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN)) Q:LRPATN<1 D Q:LREND
..S LRSPECNM="" F S LRSPECNM=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN,LRSPECNM)) Q:LRSPECNM="" D Q:LREND
...S LRSPECN=0 F S LRSPECN=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN,LRSPECNM,LRSPECN)) Q:LRSPECN<1 S LRN2=+^(LRSPECN) D Q:LREND
....S LRCDATE=0 F S LRCDATE=$O(^TMP($J,LRN2,LRCDATE)) Q:LRCDATE<1 D Q:LREND
.....S LRSUBN=0 F S LRSUBN=$O(^TMP($J,LRN2,LRCDATE,LRSUBN)) Q:LRSUBN<1 S LRX=^(LRSUBN) D DETAIL Q:LREND
Q
DETAIL S LRN3=+LRX,LRACC=$P(LRX,U,2),LRPLOS=$P(LRX,U,3),LRCOLS=$P($G(^LAB(62,+$P(LRX,U,4),0)),U),LRSTATUS=$P(LRX,U,5) I $L(LRPLOS) S LRPLOS="LOS: "_LRPLOS_" days"
D LCHECK Q:LREND W !?2,LRPATNM," ",?32,LRSPECNM," ",?52,LRACC," ",?66,$$FMTE^XLFDT(LRCDATE\1),?82,LRPLOS I LRSTATUS="M" W " ** merged **"
I LROTYPE="B" D Q:LREND
.S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
.S LRLINE=LRSPACE,LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
..S LRLINE=LRLINE_"|"_$J($P($G(^TMP($J,LRN3,"A",LRABRV)),U),3)
.S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
I LROTYPE="M",$D(^TMP($J,LRN3,"T")) D Q:LREND
.K LRTEMP,LRTEMPT S LRABRV="" F S LRABRV=$O(^TMP($J,"T",LRABRV)) Q:LRABRV="" S LRTEMP(LRABRV)=LRABRV_"="_^(LRABRV)
.D HLIST^LRMITSRS("LRTEMP","LRTEMPT",", ",IOM-LRSPACE)
.S LRABRV="" F S LRABRV=$O(LRTEMPT(LRABRV)) Q:LRABRV D LCHECK Q:LREND W !?LRSPACE,LRTEMPT(LRABRV)
.K LRTEMP,LRTEMPT
Q
LCHECK I $Y+4>IOSL D ^LRMITSRH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMITSR 4280 printed Oct 16, 2024@18:18:21 Page 2
LRMITSR ;SLC/STAFF - MICRO TREND REPORT ;10/17/92 22:52
+1 ;;5.2;LAB SERVICE;**96,257**;Sep 27, 1994
+2 ; from LRMITSP
+3 ; report may be stopped by stopping task
+4 ;
+5 DO REPORT
IF LREND
WRITE !!,"Report has been stopped."
+6 WRITE @IOF
KILL LRABRV,LRACC,LRCDATE,LRCNT,LRCOLS,LRDN,LRGPN,LRGPNM,LRGPV,LRHDR,LRHDR1,LRHDRT,LRLINE,LRLINE1,LRN,LRN1,LRN2,LRN3,LRNM
+7 KILL LRORGN,LRORGNM,LRPAGE,LRPATN,LRPATNM,LRPATNUM,LRPLOS,LRSPACE,LRSPECN,LRSPECNM,LRSTATUS,LRSUBN,LRSUSC,LRTCNT,LRTYPE,LRX
+8 QUIT
REPORT DO ^LRMITSRS
+1 IF $DATA(LRM("O"))
Begin DoDot:1
+2 SET LRPAGE=0
SET LRPATNUM=+$GET(^TMP($JOB,"O"))
SET LRTYPE="O"
DO ^LRMITSRH
if LREND
QUIT
+3 SET LRORGNM=""
FOR
SET LRORGNM=$ORDER(^TMP($JOB,LRTYPE,LRORGNM))
if LRORGNM=""
QUIT
Begin DoDot:2
+4 SET LRORGN=0
FOR
SET LRORGN=$ORDER(^TMP($JOB,LRTYPE,LRORGNM,LRORGN))
if LRORGN<1
QUIT
SET LRN1=$GET(^(LRORGN,LRORGNM,LRORGN))
Begin DoDot:3
+5 IF $DATA(LRM(LRTYPE,"S"))
IF '$DATA(LRM(LRTYPE,"S",LRORGN))
QUIT
+6 DO RESULTS
End DoDot:3
if LREND
QUIT
End DoDot:2
if LREND
QUIT
End DoDot:1
if LREND
QUIT
+7 SET LRTYPE=""
FOR
SET LRTYPE=$ORDER(LRM(LRTYPE))
if LRTYPE=""
QUIT
IF LRTYPE'="O"
Begin DoDot:1
+8 SET LRPAGE=0
SET LRPATNUM=+$GET(^TMP($JOB,LRTYPE))
DO ^LRMITSRH
if LREND
QUIT
+9 SET LRGPNM=""
FOR
SET LRGPNM=$ORDER(^TMP($JOB,LRTYPE,LRGPNM))
if LRGPNM=""
QUIT
Begin DoDot:2
+10 SET LRGPN=""
FOR
SET LRGPN=$ORDER(^TMP($JOB,LRTYPE,LRGPNM,LRGPN))
if LRGPN=""
QUIT
SET LRGPV=+^(LRGPN)
Begin DoDot:3
+11 IF $DATA(LRM(LRTYPE,"S"))
IF '$DATA(LRM(LRTYPE,"S",LRGPN))
QUIT
+12 DO LCHECK
if LREND
QUIT
WRITE !,LRGPNM," (",+LRGPV," isolates)",!,"---------------"
+13 SET LRORGNM=""
FOR
SET LRORGNM=$ORDER(^TMP($JOB,LRTYPE,LRGPNM,LRGPN,LRORGNM))
if LRORGNM=""
QUIT
Begin DoDot:4
+14 SET LRORGN=0
FOR
SET LRORGN=$ORDER(^TMP($JOB,LRTYPE,LRGPNM,LRGPN,LRORGNM,LRORGN))
if LRORGN<1
QUIT
SET LRN1=^(LRORGN)
DO RESULTS
if LREND
QUIT
End DoDot:4
if LREND
QUIT
End DoDot:3
if LREND
QUIT
End DoDot:2
if LREND
QUIT
End DoDot:1
if LREND
QUIT
+15 QUIT
RESULTS DO LCHECK
if LREND
QUIT
WRITE !,$SELECT($LENGTH(LRORGNM)<34:$EXTRACT(LRORGNM,5,34),1:$PIECE(^LAB(61.2,LRORGN,0),U))
SET LROTYPE=$EXTRACT($PIECE(LRORGNM,"(",2))
+1 SET LRX=^TMP($JOB,LRN1,"C")
DO LCHECK
if LREND
QUIT
WRITE !,"(",+LRX," counted, ",+$PIECE(LRX,U,2)," merged, ",+$PIECE(LRX,U,3)," not tested)"
+2 IF LROTYPE="B"
Begin DoDot:1
+3 SET LRNODE="^TMP($J,"_$SELECT($DATA(^TMP($JOB,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
+4 SET LRLINE="% sus"
SET LRAINT=""
FOR
SET LRAINT=$ORDER(@LRNODE)
if LRAINT=""
QUIT
Begin DoDot:2
+5 SET LRABRV=$SELECT($DATA(^TMP($JOB,"PSRT")):$GET(@LRNODE),1:LRAINT)
+6 if LRABRV=""
QUIT
+7 SET (LRSUSC,LRX)=$GET(^TMP($JOB,LRN1,"C",LRABRV))
IF LRX
SET LRSUSC=$JUSTIFY($PIECE(LRX,U,2)/LRX*100,0,0)
+8 SET LRLINE=LRLINE_"|"_$JUSTIFY(LRSUSC,3)
End DoDot:2
+9 SET LRLINE=LRLINE_"|"
DO LCHECK
if LREND
QUIT
WRITE !,LRLINE
+10 SET LRNODE="^TMP($J,"_$SELECT($DATA(^TMP($JOB,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
+11 SET LRLINE="# ctd"
SET LRAINT=""
FOR
SET LRAINT=$ORDER(@LRNODE)
if LRAINT=""
QUIT
Begin DoDot:2
+12 if LRABRV=""
QUIT
+13 SET LRABRV=$SELECT($DATA(^TMP($JOB,"PSRT")):$GET(@LRNODE),1:LRAINT)
+14 SET (LRTCNT,LRX)=$GET(^TMP($JOB,LRN1,"C",LRABRV))
IF LRX
SET LRTCNT=+LRX
+15 SET LRLINE=LRLINE_"|"_$JUSTIFY(LRTCNT,3)
End DoDot:2
+16 SET LRLINE=LRLINE_"|"
DO LCHECK
if LREND
QUIT
WRITE !,LRLINE
End DoDot:1
if LREND
QUIT
+17 ; detailed report
+18 if 'LRDETAIL
QUIT
+19 SET LRPATNM=""
FOR
SET LRPATNM=$ORDER(^TMP($JOB,LRN1,"P",LRPATNM))
if LRPATNM=""
QUIT
Begin DoDot:1
+20 SET LRPATN=0
FOR
SET LRPATN=$ORDER(^TMP($JOB,LRN1,"P",LRPATNM,LRPATN))
if LRPATN<1
QUIT
Begin DoDot:2
+21 SET LRSPECNM=""
FOR
SET LRSPECNM=$ORDER(^TMP($JOB,LRN1,"P",LRPATNM,LRPATN,LRSPECNM))
if LRSPECNM=""
QUIT
Begin DoDot:3
+22 SET LRSPECN=0
FOR
SET LRSPECN=$ORDER(^TMP($JOB,LRN1,"P",LRPATNM,LRPATN,LRSPECNM,LRSPECN))
if LRSPECN<1
QUIT
SET LRN2=+^(LRSPECN)
Begin DoDot:4
+23 SET LRCDATE=0
FOR
SET LRCDATE=$ORDER(^TMP($JOB,LRN2,LRCDATE))
if LRCDATE<1
QUIT
Begin DoDot:5
+24 SET LRSUBN=0
FOR
SET LRSUBN=$ORDER(^TMP($JOB,LRN2,LRCDATE,LRSUBN))
if LRSUBN<1
QUIT
SET LRX=^(LRSUBN)
DO DETAIL
if LREND
QUIT
End DoDot:5
if LREND
QUIT
End DoDot:4
if LREND
QUIT
End DoDot:3
if LREND
QUIT
End DoDot:2
if LREND
QUIT
End DoDot:1
if LREND
QUIT
+25 QUIT
DETAIL SET LRN3=+LRX
SET LRACC=$PIECE(LRX,U,2)
SET LRPLOS=$PIECE(LRX,U,3)
SET LRCOLS=$PIECE($GET(^LAB(62,+$PIECE(LRX,U,4),0)),U)
SET LRSTATUS=$PIECE(LRX,U,5)
IF $LENGTH(LRPLOS)
SET LRPLOS="LOS: "_LRPLOS_" days"
+1 DO LCHECK
if LREND
QUIT
WRITE !?2,LRPATNM," ",?32,LRSPECNM," ",?52,LRACC," ",?66,$$FMTE^XLFDT(LRCDATE\1),?82,LRPLOS
IF LRSTATUS="M"
WRITE " ** merged **"
+2 IF LROTYPE="B"
Begin DoDot:1
+3 SET LRNODE="^TMP($J,"_$SELECT($DATA(^TMP($JOB,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
+4 SET LRLINE=LRSPACE
SET LRAINT=""
FOR
SET LRAINT=$ORDER(@LRNODE)
if LRAINT=""
QUIT
Begin DoDot:2
+5 SET LRABRV=$SELECT($DATA(^TMP($JOB,"PSRT")):$GET(@LRNODE),1:LRAINT)
+6 SET LRLINE=LRLINE_"|"_$JUSTIFY($PIECE($GET(^TMP($JOB,LRN3,"A",LRABRV)),U),3)
End DoDot:2
+7 SET LRLINE=LRLINE_"|"
DO LCHECK
if LREND
QUIT
WRITE !,LRLINE
End DoDot:1
if LREND
QUIT
+8 IF LROTYPE="M"
IF $DATA(^TMP($JOB,LRN3,"T"))
Begin DoDot:1
+9 KILL LRTEMP,LRTEMPT
SET LRABRV=""
FOR
SET LRABRV=$ORDER(^TMP($JOB,"T",LRABRV))
if LRABRV=""
QUIT
SET LRTEMP(LRABRV)=LRABRV_"="_^(LRABRV)
+10 DO HLIST^LRMITSRS("LRTEMP","LRTEMPT",", ",IOM-LRSPACE)
+11 SET LRABRV=""
FOR
SET LRABRV=$ORDER(LRTEMPT(LRABRV))
if LRABRV
QUIT
DO LCHECK
if LREND
QUIT
WRITE !?LRSPACE,LRTEMPT(LRABRV)
+12 KILL LRTEMP,LRTEMPT
End DoDot:1
if LREND
QUIT
+13 QUIT
LCHECK IF $Y+4>IOSL
DO ^LRMITSRH
+1 QUIT
