[613] | 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
|
---|