LRARCAM6 ;DALISC/CKA - ARCHIVED RCS 14-4 REPORT PART 2
 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
 ;same as LRCAPAM6 except archived wkld file
EN ;
 S (LR("Q"),LRPG)=0
 D:(LRRTYP=1)!(LRRTYP=3) CDR Q:$G(LR("Q"))
 D:$G(LRRTYP)=2 PRNTSUM^LRARCAM8
 Q
CDR ;
 S (LRTOT,LRMT)=0,LRFIRST=1
 F  S LRMT=$O(^TMP($J,"RCS14-4",LRMT)) Q:LRMT<1!($G(LR("Q")))  I $D(^(LRMT,3))#2 S LRTOT=LRTOT+$G(^(3))
 S LRMT=0 F  S LRMT=$O(^TMP($J,"RCS14-4",LRMT)) Q:LRMT<1!($G(LR("Q")))  S LRMTP=$$DTF^LRAFUNC1(LRMT) D  Q:$G(LR("Q"))  D:$G(LRRPT)=1 DETAIL Q:$G(LR("Q"))
 .S N0=^TMP($J,"RCS14-4",LRMT,0),LRGTOT=0 F I=2,3,4,9 S LRGTOT=LRGTOT+$P(N0,U,I)
 .D HEAD Q:$G(LR("Q"))
 .S LRLINE="PTF Treating Specialty" W !!?(IOM-$L(LRLINE)\2),LRLINE,!!
 .S LRTRE=5 F  S LRTRE=$O(^TMP($J,"RCS14-4",LRMT,LRTRE)) Q:LRTRE=""  S LRTRET=^(LRTRE) W !?10,LRTRE," = ",LRTRET,?60,$J(($S(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
 .D HEAD Q:$G(LR("Q"))  S LRLINE="Service Listing" W !!?(IOM-$L(LRLINE)\2),LRLINE,!!
 .S LRTRE="" F  S LRTRE=$O(^TMP($J,"RCS14-4",LRMT,3,LRTRE)) Q:LRTRE=""!($G(LR("Q")))  S LRTRET=^(LRTRE) W !?15,LRTRE," = ",LRTRET,?60,$J(($S(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
 .D HEAD Q:$G(LR("Q"))  S LRLINE="Billing Bed Section" W !!?(IOM-$L(LRLINE)\2),LRLINE,!!
 .S LRTRE="" F  S LRTRE=$O(^TMP($J,"RCS14-4",LRMT,5,LRTRE)) Q:LRTRE=""!($G(LR("Q")))  S LRTRET=^(LRTRE) W !?20,LRTRE," = ",LRTRET,?60,$J(($S(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
 .W !
 I $E(IOST)="C-",'$G(LR("Q")) D M^LRU Q:$G(LR("Q"))
 W @IOF
 Q
DETAIL ;
 S LRCAP="" F  S LRCAP=$O(^TMP($J,"RCS14-4",LRMT,1,LRCAP)) Q:LRCAP=""!($G(LR("Q")))  I $D(^(LRCAP,0))#2 S LRCAPT=^(0) D
 .Q:$G(LR("Q"))  S LRCAPTOT=0 F I=2,3,4,9 S LRCAPTOT=LRCAPTOT+$P(LRCAPT,U,I)
 .D:(IOSL-$Y)<6 HEAD Q:$G(LR("Q"))  W !!,LRCAP," CNT = ",LRCAPTOT
 .S LRTRE1=0 F  S LRTRE1=$O(^TMP($J,"RCS14-4",LRMT,1,LRCAP,LRTRE1)) Q:LRTRE1=""!($G(LR("Q")))  S LRTRE1T=^(LRTRE1) D  W !?5,LRTRE1,?45,LRTRE1T,?55,$J(($S(LRCAPTOT:LRTRE1T/LRCAPTOT,1:0)*100),8,1)_" %"
 ..Q:$G(LR("Q"))  Q:(IOSL-$Y)>4   D HEAD Q:$G(LR("Q"))  W !!?14,LRCAP," CNT = ",LRCAPTOT
 W !!
 Q
HEAD ;
 I $E(IOST)="C" D M^LRU Q:$G(LR("Q"))
 W:('LRFIRST)!($E(IOST)="C") @IOF
 S:LRFIRST LRFIRST=0
 S LRLINE=" Total Count for Report = "
 W !,"ARCHIVED RCS-CDR/LMIP REPORT"
 W !,LRHD0
 W ?((IOM-($L(LRMTP)+$L($P(LRDA,U,2)))\2)),$P(LRDA,U,2)_"   "_LRMTP
 S LRPG=LRPG+1 W ?(IOM-10),"Page ",LRPG
 W !!?(IOM-$L(LRLINE)\2),LRLINE,LRTOT,!
 Q:'$G(LRERR)  W !,LRERR_" Errors were found in Data Base "
 W !,"Review Detail Report for Specifics",!!
 Q