73 lines
2.0 KiB
Mathematica
73 lines
2.0 KiB
Mathematica
LRCAPAM9 ;DALISC/FHS - RCS 14-4 REPORT LMIP SUPPLEMENT PAGE PRINT ;5/10/93
|
|
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
|
|
EN ;
|
|
PRNTSUM ;
|
|
S LRMT=0
|
|
F S LRMT=$O(^TMP($J,"LMIP",LRMT)) Q:LRMT<1 S LRMTP=$$FMTE^XLFDT(LRMT,"1D") D Q:$G(LR("Q"))
|
|
.W !,"LMIP SUPPLEMENTAL 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="Supplemental Pathology Laboratory Medicine Service Workload"
|
|
.W !!,?(132-$L(LRHDR)\2),LRHDR,!
|
|
.W !!,?32,"STD/Rep",?44,"Manual"
|
|
.W ?56,"Micro",?68,"Micro",?80,"In-Pat",?92,"Others",!
|
|
.W ?58,"In",?69,"Out",?80,"Stats",!
|
|
.W $E(LRDSHS,1,132),!
|
|
.D PRNTNAM
|
|
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 ?31,$J($P(LRREC,U,12),7),?43,$J($P(LRREC,U,13),7)
|
|
W ?55,$J($P(LRREC,U,14),7),?67,$J($P(LRREC,U,15),7)
|
|
W ?79,$J($P(LRREC,U,16),7),?91,$J($P(LRREC,U,17),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=12:1:17 D
|
|
. S LRGTOT=$P(LRAPSUB,U,I)+$P(LRCPSUB,U,I)
|
|
. S $P(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"),U,I)=LRGTOT
|
|
Q
|