source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRCAPAM9.m@ 1336

Last change on this file since 1336 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

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