source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMITSR.m@ 1226

Last change on this file since 1226 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1LRMITSR ;SLC/STAFF - MICRO TREND REPORT ;10/17/92 22:52
2 ;;5.2;LAB SERVICE;**96,257**;Sep 27, 1994
3 ; from LRMITSP
4 ; report may be stopped by stopping task
5 ;
6 D REPORT I LREND W !!,"Report has been stopped."
7 W @IOF K LRABRV,LRACC,LRCDATE,LRCNT,LRCOLS,LRDN,LRGPN,LRGPNM,LRGPV,LRHDR,LRHDR1,LRHDRT,LRLINE,LRLINE1,LRN,LRN1,LRN2,LRN3,LRNM
8 K LRORGN,LRORGNM,LRPAGE,LRPATN,LRPATNM,LRPATNUM,LRPLOS,LRSPACE,LRSPECN,LRSPECNM,LRSTATUS,LRSUBN,LRSUSC,LRTCNT,LRTYPE,LRX
9 Q
10REPORT D ^LRMITSRS
11 I $D(LRM("O")) D Q:LREND
12 .S LRPAGE=0,LRPATNUM=+$G(^TMP($J,"O")),LRTYPE="O" D ^LRMITSRH Q:LREND
13 .S LRORGNM="" F S LRORGNM=$O(^TMP($J,LRTYPE,LRORGNM)) Q:LRORGNM="" D Q:LREND
14 ..S LRORGN=0 F S LRORGN=$O(^TMP($J,LRTYPE,LRORGNM,LRORGN)) Q:LRORGN<1 S LRN1=$G(^(LRORGN,LRORGNM,LRORGN)) D Q:LREND
15 ...I $D(LRM(LRTYPE,"S")),'$D(LRM(LRTYPE,"S",LRORGN)) Q
16 ...D RESULTS
17 S LRTYPE="" F S LRTYPE=$O(LRM(LRTYPE)) Q:LRTYPE="" I LRTYPE'="O" D Q:LREND
18 .S LRPAGE=0,LRPATNUM=+$G(^TMP($J,LRTYPE)) D ^LRMITSRH Q:LREND
19 .S LRGPNM="" F S LRGPNM=$O(^TMP($J,LRTYPE,LRGPNM)) Q:LRGPNM="" D Q:LREND
20 ..S LRGPN="" F S LRGPN=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN)) Q:LRGPN="" S LRGPV=+^(LRGPN) D Q:LREND
21 ...I $D(LRM(LRTYPE,"S")),'$D(LRM(LRTYPE,"S",LRGPN)) Q
22 ...D LCHECK Q:LREND W !,LRGPNM," (",+LRGPV," isolates)",!,"---------------"
23 ...S LRORGNM="" F S LRORGNM=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN,LRORGNM)) Q:LRORGNM="" D Q:LREND
24 ....S LRORGN=0 F S LRORGN=$O(^TMP($J,LRTYPE,LRGPNM,LRGPN,LRORGNM,LRORGN)) Q:LRORGN<1 S LRN1=^(LRORGN) D RESULTS Q:LREND
25 Q
26RESULTS 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))
27 S LRX=^TMP($J,LRN1,"C") D LCHECK Q:LREND W !,"(",+LRX," counted, ",+$P(LRX,U,2)," merged, ",+$P(LRX,U,3)," not tested)"
28 I LROTYPE="B" D Q:LREND
29 .S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
30 .S LRLINE="% sus",LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
31 ..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
32 ..Q:LRABRV=""
33 ..S (LRSUSC,LRX)=$G(^TMP($J,LRN1,"C",LRABRV)) I LRX S LRSUSC=$J($P(LRX,U,2)/LRX*100,0,0)
34 ..S LRLINE=LRLINE_"|"_$J(LRSUSC,3)
35 .S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
36 .S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
37 .S LRLINE="# ctd",LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
38 ..Q:LRABRV=""
39 ..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
40 ..S (LRTCNT,LRX)=$G(^TMP($J,LRN1,"C",LRABRV)) I LRX S LRTCNT=+LRX
41 ..S LRLINE=LRLINE_"|"_$J(LRTCNT,3)
42 .S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
43 ; detailed report
44 Q:'LRDETAIL
45 S LRPATNM="" F S LRPATNM=$O(^TMP($J,LRN1,"P",LRPATNM)) Q:LRPATNM="" D Q:LREND
46 .S LRPATN=0 F S LRPATN=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN)) Q:LRPATN<1 D Q:LREND
47 ..S LRSPECNM="" F S LRSPECNM=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN,LRSPECNM)) Q:LRSPECNM="" D Q:LREND
48 ...S LRSPECN=0 F S LRSPECN=$O(^TMP($J,LRN1,"P",LRPATNM,LRPATN,LRSPECNM,LRSPECN)) Q:LRSPECN<1 S LRN2=+^(LRSPECN) D Q:LREND
49 ....S LRCDATE=0 F S LRCDATE=$O(^TMP($J,LRN2,LRCDATE)) Q:LRCDATE<1 D Q:LREND
50 .....S LRSUBN=0 F S LRSUBN=$O(^TMP($J,LRN2,LRCDATE,LRSUBN)) Q:LRSUBN<1 S LRX=^(LRSUBN) D DETAIL Q:LREND
51 Q
52DETAIL 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"
53 D LCHECK Q:LREND W !?2,LRPATNM," ",?32,LRSPECNM," ",?52,LRACC," ",?66,$$FMTE^XLFDT(LRCDATE\1),?82,LRPLOS I LRSTATUS="M" W " ** merged **"
54 I LROTYPE="B" D Q:LREND
55 .S LRNODE="^TMP($J,"_$S($D(^TMP($J,"PSRT")):"""PSRT""",1:"""AB""")_",LRAINT)"
56 .S LRLINE=LRSPACE,LRAINT="" F S LRAINT=$O(@LRNODE) Q:LRAINT="" D
57 ..S LRABRV=$S($D(^TMP($J,"PSRT")):$G(@LRNODE),1:LRAINT)
58 ..S LRLINE=LRLINE_"|"_$J($P($G(^TMP($J,LRN3,"A",LRABRV)),U),3)
59 .S LRLINE=LRLINE_"|" D LCHECK Q:LREND W !,LRLINE
60 I LROTYPE="M",$D(^TMP($J,LRN3,"T")) D Q:LREND
61 .K LRTEMP,LRTEMPT S LRABRV="" F S LRABRV=$O(^TMP($J,"T",LRABRV)) Q:LRABRV="" S LRTEMP(LRABRV)=LRABRV_"="_^(LRABRV)
62 .D HLIST^LRMITSRS("LRTEMP","LRTEMPT",", ",IOM-LRSPACE)
63 .S LRABRV="" F S LRABRV=$O(LRTEMPT(LRABRV)) Q:LRABRV D LCHECK Q:LREND W !?LRSPACE,LRTEMPT(LRABRV)
64 .K LRTEMP,LRTEMPT
65 Q
66LCHECK I $Y+4>IOSL D ^LRMITSRH
67 Q
Note: See TracBrowser for help on using the repository browser.