- LRARCAM6 ; IHS/DIR/AAB - ARCHIVED RCS 14-4 REPORT PART 2 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;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
- LRARCAM6 ; IHS/DIR/AAB - ARCHIVED RCS 14-4 REPORT PART 2 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
- +3 ;same as LRCAPAM6 except archived wkld file
- 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^LRARCAM8
- +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=$$DTF^LRAFUNC1(LRMT)
- 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-"
- IF '$GET(LR("Q"))
- 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 !,"ARCHIVED 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
