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

LRARCMA2.m

Go to the documentation of this file.
  1. LRARCMA2 ;DALISC/CKA - ARCHIVED WKLD REPORT BY MAJOR SECTION; 6/1/95
  1. ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
  1. ;same as LRCAPMA2 except archived wkld file
  1. EN ;
  1. TOP ;
  1. N LRCCNT,LRICNT,LROCNT,LRNCNT,LRACNT,LRCST,LRIST,LROST,LRNST,LRAST
  1. S LRHDR="ARCHIVED WORKLOAD STATISTICS BY MAJOR SECTION"
  1. S LRHDR2="REPORT DATE RANGE: "_LRDT1_" - "_LRDT2
  1. D PRTINIT^LRARCU
  1. S LRAGT=0
  1. S LRGTREC=$G(^TMP("LRAR-WL",$J,0))
  1. I $L(LRGTREC) D
  1. . S LRAGT=+$P(LRGTREC,U)
  1. I $E(IOST,1,2)="C-" W @IOF
  1. D:'LRSUMM DET
  1. D:'LREND SUM^LRARCMA3
  1. D:'LREND PRNTMAN^LRARCMR1
  1. D:'LREND COMM^LRARCMR2
  1. Q
  1. DET ;Detailed section
  1. F LRLDIV="AP","CP" D Q:LREND
  1. . S LRHDR3=$S(LRLDIV="AP":"ANATOMIC PATHOLOGY",1:"CLINICAL PATHOLOGY")
  1. . S LRIN=0
  1. . F S LRIN=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN)) Q:('LRIN)!(LREND) D
  1. . . S LRINN=$S($L($G(^LAR(64.19999,LRIN,0))):$P(^(0),U),1:LRIN)
  1. . . S LRIAGT=0
  1. . . S LRGTREC=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,0))
  1. . . I $L(LRGTREC) D
  1. . . . S LRIAGT=+$P(LRGTREC,U)
  1. . . D PRTDET
  1. . . D:('LREND)&(LRIAGT) INSTSUM
  1. Q
  1. PRTDET ;Print details
  1. D HDR^LRARCU
  1. W !,?(80-$L(LRINN)\2),LRINN,!
  1. S LRMAA=0
  1. F S LRMAA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!($G(LREND)) D
  1. . S LRLSSA=""
  1. . F S LRLSSA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!($G(LREND)) D LSS
  1. Q:LREND
  1. I $Y>(IOSL-5) D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!!
  1. I 'LRIAGT D
  1. . W !!!,"NO DATA FOR THIS INSTITUTION AND DATE RANGE",!
  1. E D
  1. . W !!!,"GRAND TOTAL",?43,$J(LRIAGT,7)
  1. D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF
  1. Q
  1. INSTSUM ;
  1. S LRLAB="!!,?(80-7\2),""SUMMARY"",!,?(80-$L(LRINN)\2),LRINN,!!,""MAJOR SECTION"",?15,""LAB SUBSECTION"",?43,"" TOTAL"",!"
  1. D HDR^LRARCU W @LRLAB
  1. S LRMAA=""
  1. F S LRMAA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA)) Q:(LRMAA="")!(LREND) D
  1. . S LRLSSA=""
  1. . F S LRLSSA=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA)) Q:(LRLSSA="")!(LREND) D PSUM
  1. I $Y>(IOSL-4) D NPG^LRARCU Q:LREND W @LRLAB
  1. W !!,"GRAND TOTAL",?43,$J(LRIAGT,7)
  1. D:($E(IOST,1,2)="C-")&('LREND) PAUSE^LRARCU W @IOF
  1. Q
  1. PSUM ;
  1. Q:LREND
  1. Q:'$D(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 S LRX=^(0)
  1. I $Y>(IOSL-3) D NPG^LRARCU Q:LREND W @LRLAB
  1. S LRACNT=$P(LRX,U)
  1. W !,$E(LRMAN(LRMAA),1,14),?15,$E(LRLSSN(LRLSSA),1,14),?31,"NUMBER :"
  1. W ?43,$J(LRACNT,7)
  1. W !,?31,"PERCENT :"
  1. W ?43,$J($S(LRIAGT:LRACNT/LRIAGT,1:0)*100,7,1)
  1. W !
  1. Q
  1. LSS ;
  1. S LRLAB="!!,""MAJOR SECTION: "",LRMAN(LRMAA),!,""LAB SUBSECTION: "",LRLSSN(LRLSSA),!!,""CODE"",?11,""PROCEDURE"",?43,"" TOTAL"",!"
  1. I $Y>(IOSL-7) D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!
  1. W @LRLAB
  1. S (LRAST,LRCC)=0
  1. F S LRCC=$O(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC)) Q:(LRCC="")!(LREND) D PCC
  1. Q:LREND
  1. S LRX=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))
  1. S LRAST=+$P(LRX,U)
  1. I $Y+4>IOSL D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
  1. W !,?11,"SUB TOTAL",?43,$J(LRAST,7),!
  1. Q
  1. PCC ;
  1. S LRX=$G(^TMP("LRAR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCC))
  1. I $Y+3>IOSL D NPG^LRARCU Q:LREND W !,?(80-$L(LRINN)\2),LRINN,!,@LRLAB
  1. S LRACNT=+$P(LRX,U)
  1. W $P(LRX,U,2),?11,$E(LRCC,1,30),?43,$J(LRACNT,7),!
  1. Q