source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRMITSR.m@ 707

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