1 | LRARCAM9 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT LMIP SUPPLEMENT PAGE PRINT ;5/23/95
|
---|
2 | ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
|
---|
3 | ;same as LRCAPAM9 except archived wkld file
|
---|
4 | EN ;
|
---|
5 | PRNTSUM ;
|
---|
6 | S LRMT=0
|
---|
7 | F S LRMT=$O(^TMP($J,"LMIP",LRMT)) Q:LRMT<1 S LRMTP=$$DTF^LRAFUNC1(LRMT) D Q:$G(LR("Q"))
|
---|
8 | .W !,"LMIP SUPPLEMENTAL REPORT printed ",LRPRD
|
---|
9 | .W !,LRHD0
|
---|
10 | .W ?((132-($L(LRMTP)+$L($P(LRDA,U,2)))\2)),$P(LRDA,U,2)_" "_LRMTP
|
---|
11 | .S LRPG=LRPG+1 W ?122,"Page ",LRPG,!
|
---|
12 | .S LRHDR="Supplemental Pathology Laboratory Medicine Service Workload"
|
---|
13 | .W !!,?(132-$L(LRHDR)\2),LRHDR,!
|
---|
14 | .W !!,?32,"STD/Rep",?44,"Manual"
|
---|
15 | .W ?56,"Micro",?68,"Micro",?80,"In-Pat",?92,"Others",!
|
---|
16 | .W ?58,"In",?69,"Out",?80,"Stats",!
|
---|
17 | .W $E(LRDSHS,1,132),!
|
---|
18 | .D PRNTNAM
|
---|
19 | Q
|
---|
20 | PRNTNAM ;
|
---|
21 | N LRRCNT,LRREC,LRLARE
|
---|
22 | S LRRCNT=0
|
---|
23 | W !,"Anatomic Pathology Division",!,$E(LRDSHS,1,27),!
|
---|
24 | S LRLARE=0
|
---|
25 | F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"AP",LRLARE)) Q:LRLARE="" D
|
---|
26 | .S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",LRLARE))
|
---|
27 | .S LRRCNT=LRRCNT+1
|
---|
28 | .W LRRCNT,?6,LRLARE
|
---|
29 | .D PRNTREC
|
---|
30 | .W !
|
---|
31 | ;Write AP subtotals
|
---|
32 | S LRLARE="AP subtotal"
|
---|
33 | S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",0))
|
---|
34 | W ?6,LRLARE
|
---|
35 | D PRNTREC
|
---|
36 | ;
|
---|
37 | W !!,"Clinical Pathology Division",!,$E(LRDSHS,1,27),!
|
---|
38 | S LRLARE=0
|
---|
39 | F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"CP",LRLARE)) Q:LRLARE="" D
|
---|
40 | .S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",LRLARE))
|
---|
41 | .S LRRCNT=LRRCNT+1
|
---|
42 | .W LRRCNT,?6,LRLARE
|
---|
43 | .D PRNTREC
|
---|
44 | .W !
|
---|
45 | ;Write CP subtotals
|
---|
46 | S LRLARE="CP subtotal"
|
---|
47 | S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",0))
|
---|
48 | W ?6,LRLARE
|
---|
49 | D PRNTREC
|
---|
50 | ;Write grand totals
|
---|
51 | W !
|
---|
52 | W $E(LRDSHS,1,132),!
|
---|
53 | S LRRCNT=LRRCNT+1,LRLARE="GRAND TOTAL"
|
---|
54 | D EDIT1
|
---|
55 | S LRREC=$G(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"))
|
---|
56 | W ?6,LRLARE
|
---|
57 | D PRNTREC
|
---|
58 | I $E(IOST,1,2)="C-",'$G(LR("Q")) D M^LRU Q:$G(LR("Q"))
|
---|
59 | W @IOF
|
---|
60 | Q
|
---|
61 | PRNTREC ;
|
---|
62 | W ?31,$J($P(LRREC,U,12),7),?43,$J($P(LRREC,U,13),7)
|
---|
63 | W ?55,$J($P(LRREC,U,14),7),?67,$J($P(LRREC,U,15),7)
|
---|
64 | W ?79,$J($P(LRREC,U,16),7),?91,$J($P(LRREC,U,17),7)
|
---|
65 | Q
|
---|
66 | EDIT1 ;
|
---|
67 | N I,LRAPSUB,LRCAPSUB,LRGTOT
|
---|
68 | S LRAPSUB=$G(^TMP($J,"LMIP",LRMT,"AP",0))
|
---|
69 | S LRCPSUB=$G(^TMP($J,"LMIP",LRMT,"CP",0))
|
---|
70 | F I=12:1:17 D
|
---|
71 | . S LRGTOT=$P(LRAPSUB,U,I)+$P(LRCPSUB,U,I)
|
---|
72 | . S $P(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"),U,I)=LRGTOT
|
---|
73 | Q
|
---|