source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRARCAM8.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1LRARCAM8 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT LMIP PAGE PRINT ;5/25/95
2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
3 ;same as LRCAPAM8 except archived wkld file
4EN ;
5PRNTSUM ;
6 N LRDSHS,LRHDR
7 S $P(LRDSHS,"-",245)="-"
8 S LRMT=0,LRPRD=$$DTF^LRAFUNC1($$NOW^LRAFUNC1)
9 F S LRMT=$O(^TMP($J,"LMIP",LRMT)) Q:LRMT<1 S LRMTP=$$DTF^LRAFUNC1(LRMT) D Q:$G(LR("Q"))
10 .W !,"LMIP REPORT printed ",LRPRD
11 .W !,LRHD0
12 .W ?((132-($L(LRMTP)+$L($P(LRDA,U,2)))\2)),$P(LRDA,U,2)_" "_LRMTP
13 .S LRPG=LRPG+1 W ?122,"Page ",LRPG,!
14 .S LRHDR="Pathology Laboratory Medicine Service Workload Summary"
15 .W !!,?(132-$L(LRHDR)\2),LRHDR,!
16 .W !!,"LINE SECTION",?28,"In-patient",?40,"Out-patient"
17 .W ?53,"Non-patient",?70,"Total",?77,"Quality",?87,"Total"
18 .W ?99,"Referred",?113,"Tests",!
19 .W "No.",?30,"Tests",?43,"Tests",?54,"""Other"""
20 .W ?70,"Tests",?77,"Control",?86,"On-site",?101,"Tests"
21 .W ?111,"Performed",?124,"Stat",!
22 .W ?55,"Tests",?67,"(Orderable)",?87,"Tests"
23 .W ?98,"(Send Outs)",?112,"On-site",?124,"Tests",!
24 .W $E(LRDSHS,1,132),!
25 .W "LMIP Data Number",?28," #5 ",?40," #6 "
26 .W ?53," #7 ",?66," #1 ",?86," #2 "
27 .W ?95," #4 ",?111," #3 ",?122," #8 ",!
28 .W $E(LRDSHS,1,132),!
29 .D PRNTNAM
30SUP ;
31 D ^LRARCAM9
32 Q
33PRNTNAM ;
34 N LRRCNT,LRREC,LRLARE
35 S LRRCNT=0
36 W !,"Anatomic Pathology Division",!,$E(LRDSHS,1,27),!
37 S LRLARE=0
38 F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"AP",LRLARE)) Q:LRLARE="" D
39 .S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",LRLARE))
40 .S LRRCNT=LRRCNT+1
41 .W LRRCNT,?6,LRLARE
42 .D PRNTREC
43 .W !
44 ;Write AP subtotals
45 S LRLARE="AP subtotal"
46 S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",0))
47 W ?6,LRLARE
48 D PRNTREC
49 ;
50 W !!,"Clinical Pathology Division",!,$E(LRDSHS,1,27),!
51 S LRLARE=0
52 F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"CP",LRLARE)) Q:LRLARE="" D
53 .S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",LRLARE))
54 .S LRRCNT=LRRCNT+1
55 .W LRRCNT,?6,LRLARE
56 .D PRNTREC
57 .W !
58 ;Write CP subtotals
59 S LRLARE="CP subtotal"
60 S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",0))
61 W ?6,LRLARE
62 D PRNTREC
63 ;Write grand totals
64 W !
65 W $E(LRDSHS,1,132),!
66 S LRRCNT=LRRCNT+1,LRLARE="GRAND TOTAL"
67 D EDIT1
68 S LRREC=$G(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"))
69 W ?6,LRLARE
70 D PRNTREC
71 I $E(IOST,1,2)="C-",'$G(LR("Q")) D M^LRU Q:$G(LR("Q"))
72 W @IOF
73 Q
74PRNTREC ;
75 W ?28,$J($P(LRREC,U),10),?40,$J($P(LRREC,U,2),11)
76 W ?53,$J($P(LRREC,U,3),11),?66,$J($P(LRREC,U,4),9)
77 W ?77,$J($P(LRREC,U,5),7),?86,$J($P(LRREC,U,6),7)
78 W ?95,$J($P(LRREC,U,7),14),?111,$J($P(LRREC,U,8),9)
79 W ?122,$J($P(LRREC,U,9),7),!
80 Q
81EDIT1 ;
82 N I,LRAPSUB,LRCAPSUB,LRGTOT
83 S LRAPSUB=$G(^TMP($J,"LMIP",LRMT,"AP",0))
84 S LRCPSUB=$G(^TMP($J,"LMIP",LRMT,"CP",0))
85 F I=1:1:9 D
86 . S LRGTOT=$P(LRAPSUB,U,I)+$P(LRCPSUB,U,I)
87 . S $P(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"),U,I)=LRGTOT
88 Q
Note: See TracBrowser for help on using the repository browser.