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