LRCAPAM6 ;DALISC/FHS - RCS 14-4 REPORT PART 2
;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
S (LR("Q"),LRPG)=0
D:(LRRTYP=1)!(LRRTYP=3) CDR Q:$G(LR("Q"))
D:$G(LRRTYP)=2 PRNTSUM^LRCAPAM8
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=$$FMTE^XLFDT(LRMT,"1D") 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" 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 !,"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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPAM6 2458 printed Sep 23, 2025@19:48:20 Page 2
LRCAPAM6 ;DALISC/FHS - RCS 14-4 REPORT PART 2
+1 ;;5.2;LAB SERVICE;**201**;Sep 27, 1994
EN ;
+1 SET (LR("Q"),LRPG)=0
+2 if (LRRTYP=1)!(LRRTYP=3)
DO CDR
if $GET(LR("Q"))
QUIT
+3 if $GET(LRRTYP)=2
DO PRNTSUM^LRCAPAM8
+4 QUIT
CDR ;
+1 SET (LRTOT,LRMT)=0
SET LRFIRST=1
+2 FOR
SET LRMT=$ORDER(^TMP($JOB,"RCS14-4",LRMT))
if LRMT<1!($GET(LR("Q")))
QUIT
IF $DATA(^(LRMT,3))#2
SET LRTOT=LRTOT+$GET(^(3))
+3 SET LRMT=0
FOR
SET LRMT=$ORDER(^TMP($JOB,"RCS14-4",LRMT))
if LRMT<1!($GET(LR("Q")))
QUIT
SET LRMTP=$$FMTE^XLFDT(LRMT,"1D")
Begin DoDot:1
+4 SET N0=^TMP($JOB,"RCS14-4",LRMT,0)
SET LRGTOT=0
FOR I=2,3,4,9
SET LRGTOT=LRGTOT+$PIECE(N0,U,I)
+5 DO HEAD
if $GET(LR("Q"))
QUIT
+6 SET LRLINE="PTF Treating Specialty"
WRITE !!?(IOM-$LENGTH(LRLINE)\2),LRLINE,!!
+7 SET LRTRE=5
FOR
SET LRTRE=$ORDER(^TMP($JOB,"RCS14-4",LRMT,LRTRE))
if LRTRE=""
QUIT
SET LRTRET=^(LRTRE)
WRITE !?10,LRTRE," = ",LRTRET,?60,$JUSTIFY(($SELECT(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
+8 DO HEAD
if $GET(LR("Q"))
QUIT
SET LRLINE="Service Listing"
WRITE !!?(IOM-$LENGTH(LRLINE)\2),LRLINE,!!
+9 SET LRTRE=""
FOR
SET LRTRE=$ORDER(^TMP($JOB,"RCS14-4",LRMT,3,LRTRE))
if LRTRE=""!($GET(LR("Q")))
QUIT
SET LRTRET=^(LRTRE)
WRITE !?15,LRTRE," = ",LRTRET,?60,$JUSTIFY(($SELECT(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
+10 DO HEAD
if $GET(LR("Q"))
QUIT
SET LRLINE="Billing Bed Section"
WRITE !!?(IOM-$LENGTH(LRLINE)\2),LRLINE,!!
+11 SET LRTRE=""
FOR
SET LRTRE=$ORDER(^TMP($JOB,"RCS14-4",LRMT,5,LRTRE))
if LRTRE=""!($GET(LR("Q")))
QUIT
SET LRTRET=^(LRTRE)
WRITE !?20,LRTRE," = ",LRTRET,?60,$JUSTIFY(($SELECT(LRTOT:LRTRET/LRTOT,1:0)*100),8,1)_" %"
+12 WRITE !
End DoDot:1
if $GET(LR("Q"))
QUIT
if $GET(LRRPT)=1
DO DETAIL
if $GET(LR("Q"))
QUIT
+13 IF $EXTRACT(IOST)="C"
DO M^LRU
if $GET(LR("Q"))
QUIT
+14 WRITE @IOF
+15 QUIT
DETAIL ;
+1 SET LRCAP=""
FOR
SET LRCAP=$ORDER(^TMP($JOB,"RCS14-4",LRMT,1,LRCAP))
if LRCAP=""!($GET(LR("Q")))
QUIT
IF $DATA(^(LRCAP,0))#2
SET LRCAPT=^(0)
Begin DoDot:1
+2 if $GET(LR("Q"))
QUIT
SET LRCAPTOT=0
FOR I=2,3,4,9
SET LRCAPTOT=LRCAPTOT+$PIECE(LRCAPT,U,I)
+3 if (IOSL-$Y)<6
DO HEAD
if $GET(LR("Q"))
QUIT
WRITE !!,LRCAP," CNT = ",LRCAPTOT
+4 SET LRTRE1=0
FOR
SET LRTRE1=$ORDER(^TMP($JOB,"RCS14-4",LRMT,1,LRCAP,LRTRE1))
if LRTRE1=""!($GET(LR("Q")))
QUIT
SET LRTRE1T=^(LRTRE1)
Begin DoDot:2
+5 if $GET(LR("Q"))
QUIT
if (IOSL-$Y)>4
QUIT
DO HEAD
if $GET(LR("Q"))
QUIT
WRITE !!?14,LRCAP," CNT = ",LRCAPTOT
End DoDot:2
WRITE !?5,LRTRE1,?45,LRTRE1T,?55,$JUSTIFY(($SELECT(LRCAPTOT:LRTRE1T/LRCAPTOT,1:0)*100),8,1)_" %"
End DoDot:1
+6 WRITE !!
+7 QUIT
HEAD ;
+1 IF $EXTRACT(IOST)="C"
DO M^LRU
if $GET(LR("Q"))
QUIT
+2 if ('LRFIRST)!($EXTRACT(IOST)="C")
WRITE @IOF
+3 if LRFIRST
SET LRFIRST=0
+4 SET LRLINE=" Total Count for Report = "
+5 WRITE !,"RCS-CDR/LMIP REPORT"
+6 WRITE !,LRHD0
+7 WRITE ?((IOM-($LENGTH(LRMTP)+$LENGTH($PIECE(LRDA,U,2)))\2)),$PIECE(LRDA,U,2)_" "_LRMTP
+8 SET LRPG=LRPG+1
WRITE ?(IOM-10),"Page ",LRPG
+9 WRITE !!?(IOM-$LENGTH(LRLINE)\2),LRLINE,LRTOT,!
+10 if '$GET(LRERR)
QUIT
WRITE !,LRERR_" Errors were found in Data Base "
+11 WRITE !,"Review Detail Report for Specifics",!!
+12 QUIT
