VistA-WorldVistAEHR/r/LAB_SERVICE-LR-LS/LRARCAM8.m

89 lines
2.7 KiB
Mathematica

LRARCAM8 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT LMIP PAGE PRINT ;5/25/95
;;5.2;LAB SERVICE;**59**;Aug 31, 1995
;same as LRCAPAM8 except archived wkld file
EN ;
PRNTSUM ;
N LRDSHS,LRHDR
S $P(LRDSHS,"-",245)="-"
S LRMT=0,LRPRD=$$DTF^LRAFUNC1($$NOW^LRAFUNC1)
F S LRMT=$O(^TMP($J,"LMIP",LRMT)) Q:LRMT<1 S LRMTP=$$DTF^LRAFUNC1(LRMT) D Q:$G(LR("Q"))
.W !,"LMIP REPORT printed ",LRPRD
.W !,LRHD0
.W ?((132-($L(LRMTP)+$L($P(LRDA,U,2)))\2)),$P(LRDA,U,2)_" "_LRMTP
.S LRPG=LRPG+1 W ?122,"Page ",LRPG,!
.S LRHDR="Pathology Laboratory Medicine Service Workload Summary"
.W !!,?(132-$L(LRHDR)\2),LRHDR,!
.W !!,"LINE SECTION",?28,"In-patient",?40,"Out-patient"
.W ?53,"Non-patient",?70,"Total",?77,"Quality",?87,"Total"
.W ?99,"Referred",?113,"Tests",!
.W "No.",?30,"Tests",?43,"Tests",?54,"""Other"""
.W ?70,"Tests",?77,"Control",?86,"On-site",?101,"Tests"
.W ?111,"Performed",?124,"Stat",!
.W ?55,"Tests",?67,"(Orderable)",?87,"Tests"
.W ?98,"(Send Outs)",?112,"On-site",?124,"Tests",!
.W $E(LRDSHS,1,132),!
.W "LMIP Data Number",?28," #5 ",?40," #6 "
.W ?53," #7 ",?66," #1 ",?86," #2 "
.W ?95," #4 ",?111," #3 ",?122," #8 ",!
.W $E(LRDSHS,1,132),!
.D PRNTNAM
SUP ;
D ^LRARCAM9
Q
PRNTNAM ;
N LRRCNT,LRREC,LRLARE
S LRRCNT=0
W !,"Anatomic Pathology Division",!,$E(LRDSHS,1,27),!
S LRLARE=0
F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"AP",LRLARE)) Q:LRLARE="" D
.S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",LRLARE))
.S LRRCNT=LRRCNT+1
.W LRRCNT,?6,LRLARE
.D PRNTREC
.W !
;Write AP subtotals
S LRLARE="AP subtotal"
S LRREC=$G(^TMP($J,"LMIP",LRMT,"AP",0))
W ?6,LRLARE
D PRNTREC
;
W !!,"Clinical Pathology Division",!,$E(LRDSHS,1,27),!
S LRLARE=0
F S LRLARE=$O(^TMP($J,"LMIP",LRMT,"CP",LRLARE)) Q:LRLARE="" D
.S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",LRLARE))
.S LRRCNT=LRRCNT+1
.W LRRCNT,?6,LRLARE
.D PRNTREC
.W !
;Write CP subtotals
S LRLARE="CP subtotal"
S LRREC=$G(^TMP($J,"LMIP",LRMT,"CP",0))
W ?6,LRLARE
D PRNTREC
;Write grand totals
W !
W $E(LRDSHS,1,132),!
S LRRCNT=LRRCNT+1,LRLARE="GRAND TOTAL"
D EDIT1
S LRREC=$G(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"))
W ?6,LRLARE
D PRNTREC
I $E(IOST,1,2)="C-",'$G(LR("Q")) D M^LRU Q:$G(LR("Q"))
W @IOF
Q
PRNTREC ;
W ?28,$J($P(LRREC,U),10),?40,$J($P(LRREC,U,2),11)
W ?53,$J($P(LRREC,U,3),11),?66,$J($P(LRREC,U,4),9)
W ?77,$J($P(LRREC,U,5),7),?86,$J($P(LRREC,U,6),7)
W ?95,$J($P(LRREC,U,7),14),?111,$J($P(LRREC,U,8),9)
W ?122,$J($P(LRREC,U,9),7),!
Q
EDIT1 ;
N I,LRAPSUB,LRCAPSUB,LRGTOT
S LRAPSUB=$G(^TMP($J,"LMIP",LRMT,"AP",0))
S LRCPSUB=$G(^TMP($J,"LMIP",LRMT,"CP",0))
F I=1:1:9 D
. S LRGTOT=$P(LRAPSUB,U,I)+$P(LRCPSUB,U,I)
. S $P(^TMP($J,"LMIP",LRMT,"TOT-AP/CP"),U,I)=LRGTOT
Q