- LRRP6A2 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-CONDENSED ;11/27/92
- ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- COND ;
- N LRLINE
- S $P(LRLINE,"-",IOM)="-"
- D TEST Q:LREND
- D WKLD
- Q
- TEST ;
- S LRSUBH="Lab Test/WKLD Code Summary"
- D HDR
- W !!,LRSUBH,!,$E(LRDASH,1,IOM)
- S LRTNAM=""
- F S LRTNAM=$O(^TMP("LR",$J,"TST",LRTNAM)) Q:(LREND)!(LRTNAM="") D
- . I $Y+7>IOSL D
- . . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
- . . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
- . Q:LREND
- . W !,$E(LRTNAM,1,12)
- . S LRFIRST=1 D CAP
- I '$D(^TMP("LR",$J,"TST")) S LRTIC=" Test " D NODATA S LREND=1 QUIT
- Q:LREND
- W LRDASH
- W !!,"TOTAL",?74,$J(^TMP("LR",$J,"TST"),6)
- D:$E(IOST,1,2)="C-" PAUSE Q:LREND W @IOF
- Q
- CAP ;
- S LRCAPNAM=""
- F S LRCAPNAM=$O(^TMP("LR",$J,"TST",LRTNAM,LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
- . I $Y+6>IOSL D
- . . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
- . . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
- . . W !,LRTNAM
- . . S LRFIRST=1
- . Q:LREND
- . W:'LRFIRST !
- . S:LRFIRST LRFIRST=0
- . W ?9,$E(LRCAPNAM,1,50),?62,$J(LRCC(LRCAPNAM),12,4)
- . W ?74,$J(^TMP("LR",$J,"TST",LRTNAM,LRCAPNAM),6)
- Q:LREND
- W !,LRLINE
- W !,"SUBTOTAL",?74,$J(^TMP("LR",$J,"TST",LRTNAM),6),!
- Q
- WKLD ;
- S LRSUBH="WKLD Code Summary"
- D HDR
- W !!,LRSUBH,!,$E(LRDASH,1,IOM)
- S LRCAPNAM=""
- F S LRCAPNAM=$O(^TMP("LR",$J,"WKLD",LRCAPNAM)) Q:(LREND)!(LRCAPNAM="") D
- . I $Y+6>IOSL D
- . . D:$E(IOST,1,2)="C-" PAUSE Q:LREND
- . . W @IOF D HDR W !!,LRSUBH_" ** cont. **",!,$E(LRDASH,1,IOM)
- . Q:LREND
- . W !,LRCAPNAM,?55,$J(LRCC(LRCAPNAM),12,4)
- . W ?70,$J(^TMP("LR",$J,"WKLD",LRCAPNAM),6)
- Q:LREND
- I '$D(^TMP("LR",$J,"WKLD")) S LRTIC=" Workload " D NODATA QUIT
- W !,$E(LRDASH,1,IOM)
- W !!,"TOTAL",?70,$J(^TMP("LR",$J),6)
- Q
- HDR ;
- S LRPAG=LRPAG+1
- W !!,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
- W ?(62),LRDAT,?(72)," PAGE ",LRPAG
- W !,"Accession Area: ",LRX
- W !!,$E(LRSTAR,1,34)," CONDENSED ",$E(LRSTAR,1,33)
- Q
- NODATA ;
- W !!,"No",LRTIC,"data for this date range.",!!!
- D PAUSE
- Q
- PAUSE ;
- K DIR S DIR(0)="E" D ^DIR
- S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRRP6A2 2165 printed Jan 18, 2025@03:20:41 Page 2
- LRRP6A2 ;DALISC/J0/DRH - LAB TEST SUMMARY REPORT-CONDENSED ;11/27/92
- +1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
- EN ;
- COND ;
- +1 NEW LRLINE
- +2 SET $PIECE(LRLINE,"-",IOM)="-"
- +3 DO TEST
- if LREND
- QUIT
- +4 DO WKLD
- +5 QUIT
- TEST ;
- +1 SET LRSUBH="Lab Test/WKLD Code Summary"
- +2 DO HDR
- +3 WRITE !!,LRSUBH,!,$EXTRACT(LRDASH,1,IOM)
- +4 SET LRTNAM=""
- +5 FOR
- SET LRTNAM=$ORDER(^TMP("LR",$JOB,"TST",LRTNAM))
- if (LREND)!(LRTNAM="")
- QUIT
- Begin DoDot:1
- +6 IF $Y+7>IOSL
- Begin DoDot:2
- +7 if $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- if LREND
- QUIT
- +8 WRITE @IOF
- DO HDR
- WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
- End DoDot:2
- +9 if LREND
- QUIT
- +10 WRITE !,$EXTRACT(LRTNAM,1,12)
- +11 SET LRFIRST=1
- DO CAP
- End DoDot:1
- +12 IF '$DATA(^TMP("LR",$JOB,"TST"))
- SET LRTIC=" Test "
- DO NODATA
- SET LREND=1
- QUIT
- +13 if LREND
- QUIT
- +14 WRITE LRDASH
- +15 WRITE !!,"TOTAL",?74,$JUSTIFY(^TMP("LR",$JOB,"TST"),6)
- +16 if $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- if LREND
- QUIT
- WRITE @IOF
- +17 QUIT
- CAP ;
- +1 SET LRCAPNAM=""
- +2 FOR
- SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"TST",LRTNAM,LRCAPNAM))
- if (LREND)!(LRCAPNAM="")
- QUIT
- Begin DoDot:1
- +3 IF $Y+6>IOSL
- Begin DoDot:2
- +4 if $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- if LREND
- QUIT
- +5 WRITE @IOF
- DO HDR
- WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
- +6 WRITE !,LRTNAM
- +7 SET LRFIRST=1
- End DoDot:2
- +8 if LREND
- QUIT
- +9 if 'LRFIRST
- WRITE !
- +10 if LRFIRST
- SET LRFIRST=0
- +11 WRITE ?9,$EXTRACT(LRCAPNAM,1,50),?62,$JUSTIFY(LRCC(LRCAPNAM),12,4)
- +12 WRITE ?74,$JUSTIFY(^TMP("LR",$JOB,"TST",LRTNAM,LRCAPNAM),6)
- End DoDot:1
- +13 if LREND
- QUIT
- +14 WRITE !,LRLINE
- +15 WRITE !,"SUBTOTAL",?74,$JUSTIFY(^TMP("LR",$JOB,"TST",LRTNAM),6),!
- +16 QUIT
- WKLD ;
- +1 SET LRSUBH="WKLD Code Summary"
- +2 DO HDR
- +3 WRITE !!,LRSUBH,!,$EXTRACT(LRDASH,1,IOM)
- +4 SET LRCAPNAM=""
- +5 FOR
- SET LRCAPNAM=$ORDER(^TMP("LR",$JOB,"WKLD",LRCAPNAM))
- if (LREND)!(LRCAPNAM="")
- QUIT
- Begin DoDot:1
- +6 IF $Y+6>IOSL
- Begin DoDot:2
- +7 if $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- if LREND
- QUIT
- +8 WRITE @IOF
- DO HDR
- WRITE !!,LRSUBH_" ** cont. **",!,$EXTRACT(LRDASH,1,IOM)
- End DoDot:2
- +9 if LREND
- QUIT
- +10 WRITE !,LRCAPNAM,?55,$JUSTIFY(LRCC(LRCAPNAM),12,4)
- +11 WRITE ?70,$JUSTIFY(^TMP("LR",$JOB,"WKLD",LRCAPNAM),6)
- End DoDot:1
- +12 if LREND
- QUIT
- +13 IF '$DATA(^TMP("LR",$JOB,"WKLD"))
- SET LRTIC=" Workload "
- DO NODATA
- QUIT
- +14 WRITE !,$EXTRACT(LRDASH,1,IOM)
- +15 WRITE !!,"TOTAL",?70,$JUSTIFY(^TMP("LR",$JOB),6)
- +16 QUIT
- HDR ;
- +1 SET LRPAG=LRPAG+1
- +2 WRITE !!,"Detailed AUDIT REPORT (by Test) for ",LRDATRNG
- +3 WRITE ?(62),LRDAT,?(72)," PAGE ",LRPAG
- +4 WRITE !,"Accession Area: ",LRX
- +5 WRITE !!,$EXTRACT(LRSTAR,1,34)," CONDENSED ",$EXTRACT(LRSTAR,1,33)
- +6 QUIT
- NODATA ;
- +1 WRITE !!,"No",LRTIC,"data for this date range.",!!!
- +2 DO PAUSE
- +3 QUIT
- PAUSE ;
- +1 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- +2 if ($DATA(DTOUT)#2)!($DATA(DUOUT)#2)!($DATA(DIRUT)#2)
- SET LREND=1
- +3 QUIT