68 lines
4.1 KiB
Mathematica
68 lines
4.1 KiB
Mathematica
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
|