- 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 Feb 18, 2025@23:43:29 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
