Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRRP6B2

LRRP6B2.m

Go to the documentation of this file.
LRRP6B2 ; IHS/DIR/FJE - WORKLOAD CODE SUMMARY REPORT-CONDENSED ; 
 ;;5.2;LR;**1013**;JUL 15, 2002
 ;
 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
COND ;
 D WKLD Q:LREND
 D TEST Q:LREND
 D VENI
 Q
WKLD ;
 S LRSUBH="Workload 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 !,$E(LRCAPNAM,1,50),?55,$J(LRCC(LRCAPNAM),12,4)
 . W ?70,$J(^TMP("LR",$J,"WKLD",LRCAPNAM),5)
 Q:LREND
 I '$D(^TMP("LR",$J,"WKLD")) S LRTIC=" Workload " D NODATA QUIT
 W !,$E(LRDASH,1,IOM),!,"TOTAL",?70,$J(^TMP("LR",$J,"WKLD"),5)
 D:$E(IOST,1,2)="C-" PAUSE Q:LREND  W @IOF
 Q
NODATA ;
 W !!,"No",LRTIC,"data for this date range.",!!!
 D PAUSE
 Q
TEST ;
 S LRSUBH="Lab Test 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+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 !,LRTNAM,?74,$J(^TMP("LR",$J,"TST",LRTNAM),5)
 Q:LREND
 I '$D(^TMP("LR",$J,"TST")) S LRTIC=" Test " D NODATA S LREND=1 QUIT
 W !,$E(LRDASH,1,IOM),!,"TOTAL",?74,$J(^TMP("LR",$J,"TST"),5)
 D:$E(IOST,1,2)="C-" PAUSE Q:LREND  W @IOF
 Q
VENI ;
 S LRSUBH="Venipuncture Summary"
 D HDR
 W !!,LRSUBH,!,$E(LRDASH,1,IOM)
 I $D(^TMP("LR",$J,"VENI")) D
 . F  S LRCAPNAM=$O(^TMP("LR",$J,"VENI",LRCAPNAM)) Q:(LREND)!(LRCAPNAM="")  D
 . . W !,$E(LRCAPNAM,1,50),?60,$J(LRCC(LRCAPNAM),12,4)
 . . W ?74,$J(^TMP("LR",$J,"VENI",LRCAPNAM),5)
 . W !,$E(LRDASH,1,IOM),!,"TOTAL",?74,$J(^TMP("LR",$J,"VENI"),5)
 E  W !,"NO VENIPUNCTURE DATA"
 Q
HDR ;
 W @IOF
 S LRPAG=LRPAG+1
 W !,"Detailed Workload Report (by WKLD Code) for ",LRDATRNG
 W ?(72),"PAGE ",$J(LRPAG,3)
 S LRDAT1="(Print date: "_LRDAT_")"
 W !?IOM-(IOM-$L(LRDAT1)),LRDAT1 K LRDAT1
 W !!,$E(LRSTAR,1,34),"  CONDENSED  ",$E(LRSTAR,1,33)
 Q
PAUSE ;
 K DIR S DIR(0)="E" D ^DIR
 S:($D(DTOUT)#2)!($D(DUOUT)#2)!($D(DIRUT)#2) LREND=1
 Q