source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARCAM9.m@ 1383

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1LRARCAM9 ;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
4EN ;
5PRNTSUM ;
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
20PRNTNAM ;
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
61PRNTREC ;
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
66EDIT1 ;
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
Note: See TracBrowser for help on using the repository browser.