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

LRCAPAM8.m

Go to the documentation of this file.
LRCAPAM8 ;DALISC/J0 - RCS 14-4 REPORT LMIP PAGE PRINT ;5/10/93
 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
PRNTSUM ;
 N LRDSHS,LRHDR
 S $P(LRDSHS,"-",245)="-"
 S LRMT=0,LRPRD=$TR($$FMTE^XLFDT($$NOW^XLFDT,"1M"),"@"," ")
 F  S LRMT=$O(^TMP($J,"LMIP",LRMT)) Q:LRMT<1  S LRMTP=$$FMTE^XLFDT(LRMT,"1D") D  Q:$G(LR("Q"))
 .W !,"LMIP REPORT printed ",LRPRD
 .W !,LRHD0
 .W ?((132-($L(LRMTP)+$L($P(LRDA,U,2)))\2)),$P(LRDA,U,2)_"   "_LRMTP
 .S LRPG=LRPG+1 W ?122,"Page ",LRPG,!
 .S LRHDR="Pathology Laboratory Medicine Service Workload Summary"
 .W !!,?(132-$L(LRHDR)\2),LRHDR,!
 .W !!,"LINE  SECTION",?28,"In-patient",?40,"Out-patient"
 .W ?53,"Non-patient",?70,"Total",?77,"Quality",?87,"Total"
 .W ?99,"Referred",?113,"Tests",!
 .W "No.",?30,"Tests",?43,"Tests",?54,"""Other"""
 .W ?70,"Tests",?77,"Control",?86,"On-site",?101,"Tests"
 .W ?111,"Performed",?124,"Stat",!
 .W ?55,"Tests",?67,"(Orderable)",?87,"Tests"
 .W ?98,"(Send Outs)",?112,"On-site",?124,"Tests",!
 .W $E(LRDSHS,1,132),!
 .W "LMIP Data Number",?28,"    #5    ",?40,"    #6     "
 .W ?53,"    #7     ",?66,"     #1  ",?86,"  #2   "
 .W ?95,"      #4      ",?111,"   #3    ",?122,"   #8  ",!
 .W $E(LRDSHS,1,132),!
 .D PRNTNAM
SUP ;
 D ^LRCAPAM9
 Q
PRNTNAM ;
 N LRRCNT,LRREC,LRLARE
 S LRRCNT=0
 W !,"Anatomic Pathology Division",!,$E(LRDSHS,1,27),!
 S LRLARE=0
 F  S LRLARE=$O(^TMP($J,"LMIP",LRMT,"AP",LRLARE)) Q:LRLARE=""  D
 .S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",LRLARE))
 .S LRRCNT=LRRCNT+1
 .W LRRCNT,?6,LRLARE
 .D PRNTREC
 .W !
 ;Write AP subtotals
 S LRLARE="AP subtotal"
 S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",0))
 W ?6,LRLARE
 D PRNTREC
 ;
 W !!,"Clinical Pathology Division",!,$E(LRDSHS,1,27),!
 S LRLARE=0
 F  S LRLARE=$O(^TMP($J,"LMIP",LRMT,"CP",LRLARE)) Q:LRLARE=""  D
 .S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",LRLARE))
 .S LRRCNT=LRRCNT+1
 .W LRRCNT,?6,LRLARE
 .D PRNTREC
 .W !
 ;Write CP subtotals
 S LRLARE="CP subtotal"
 S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",0))
 W ?6,LRLARE
 D PRNTREC
 ;Write grand totals
 W !
 W $E(LRDSHS,1,132),!
 S LRRCNT=LRRCNT+1,LRLARE="GRAND TOTAL"
 D EDIT1
 S LRREC=$G(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"))
 W ?6,LRLARE
 D PRNTREC
 I $E(IOST,1,2)="C-" D M^LRU Q:$G(LR("Q"))
 W @IOF
 Q
PRNTREC ;
 W ?28,$J($P(LRREC,U),10),?40,$J($P(LRREC,U,2),11)
 W ?53,$J($P(LRREC,U,3),11),?66,$J($P(LRREC,U,4),9)
 W ?77,$J($P(LRREC,U,5),7),?86,$J($P(LRREC,U,6),7)
 W ?95,$J($P(LRREC,U,7),14),?111,$J($P(LRREC,U,8),9)
 W ?122,$J($P(LRREC,U,9),7),!
 Q
EDIT1 ;
 N I,LRAPSUB,LRCAPSUB,LRGTOT
 S LRAPSUB=$G(^TMP($J,"LMIP",LRMT,"AP",0))
 S LRCPSUB=$G(^TMP($J,"LMIP",LRMT,"CP",0))
 F I=1:1:9 D
 . S LRGTOT=$P(LRAPSUB,U,I)+$P(LRCPSUB,U,I)
 . S $P(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"),U,I)=LRGTOT
 Q