source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRCAPAM7.m@ 636

LRCAPAM7 ;DALISC/J0 - RCS 14-4 REPORT, LMIP PAGE COUNTERS ;5/10/93
 ;;5.2;LAB SERVICE;;Sep 27, 1994
EN ;
INITSUM ;
 N LRIFN,LRREC,LRLARE,LRLDIV,I
 S LRIFN=0
 F  S LRIFN=$O(^LAB(64.21,LRIFN)) Q:'LRIFN  I LRIFN'=8 D
 .S LRREC=$G(^LAB(64.21,LRIFN,0))
 .Q:'$L(LRREC)
 .S LRLDIV=$P(LRREC,U,4)
 .Q:'$L(LRLDIV)
 .S LRLARE=$P(LRREC,U)
 .Q:'$L(LRLARE)
 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0),U,I)=0
 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE),U,I)=0
 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE),U,I)=0
 F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP"),U,I)=0
 Q
BMPSUM ;
 ;LRIPOT(2)=in-patient ; LROPOT(3)=outpatient ; LRNPOT(4)=other patients (REFERRAL)
 ;LRQC=qc(5) ; LRTOST=total on site ; LRMAN(8)=manual input
 ;LROTHER(12)=other ; LRSOOT(10)=send out flag ; LROSOT= total performed on-site test
 ;LRSOT(7)=total stat ; LRSOTI(6)= total inpatient stat
 ;LRTOT= total ordered test
 ;LRREP(11)=std/reps LRMII=Micro In-house LRMIO=Micro Sendout
 ;LRSUBF=suffix
 N LRREP,LRREC,LRIPOT,LROPOT,LRNPOT,LRQC,LRSOT,LRMAN,LRSOOT,LROSOT,LRTOT,LRTOST
 N LRREC2,LRREC3,LRSKIP,LRLDIV,LRLARE,LROTHER
 N LRSOTI,LRMII,LRMIO,LRSUBF
 S LRSOTI=$P(LRN,U,6),LRSUBF=$P($P(LRN,U),".",2)
 S LRIPOT=+$P(LRN,U,2),LROPOT=+$P(LRN,U,3),LRNPOT=+$P(LRN,U,4)
 S LRQC=+$P(LRN,U,5),LRSOT=+$P(LRN,U,7),LRMAN=+$P(LRN,U,8)
 S LRSOOT=+$P(LRN,U,10),LRREP=$P(LRN,U,11),LROTHER=+$P(LRN,U,12)
 S LROSOT=$S(LRSOOT:0,1:(LRIPOT+LROPOT+LRNPOT))
 S LRTOT=LRIPOT+LROPOT+LRNPOT
 S LRTOST=LRIPOT+LROPOT+LRNPOT+LRMAN+LRQC+LROTHER+LRREP
 I $E(LRSUBF,3,4)="00" D
 . I LRSUBF>8000,LRSUBF<9000,LRSUBF'=8500,LRSUBF'=8600 S LRMIO=LRTOT
 . I LRSUBF>7000,LRSUBF<8000,LRSUBF'=7500,LRSUBF'=7600 S LRMII=LRTOT
 . S:'$D(LRMIPER) LRMIPER="^"
 . S $P(LRMIPER,U)=$P(LRMIPER,U)+$G(LRMIO),$P(LRMIPER,U,2)=$P(LRMIPER,U,2)+$G(LRMII)
 D GETDA Q:LRSKIP
 ;bump div/area counts
 S LRREC=$G(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE))
 S $P(LRREC,U)=$P(LRREC,U)+LRIPOT ;LMIP field #5
 S $P(LRREC,U,2)=$P(LRREC,U,2)+LROPOT ;LMIP field #6
 S $P(LRREC,U,3)=$P(LRREC,U,3)+LRNPOT ;LMIP field #7
 S $P(LRREC,U,4)=$P(LRREC,U,4)+LRTOT ;LMIP field #1
 S $P(LRREC,U,5)=$P(LRREC,U,5)+LRQC ;no LIMP field #
 S $P(LRREC,U,6)=$P(LRREC,U,6)+LRTOST ;LMIP field #2
 S $P(LRREC,U,7)=$P(LRREC,U,7)+LRSOOT ;LMIP field #4
 S $P(LRREC,U,8)=$P(LRREC,U,8)+LROSOT ;LMIP field #3
 S $P(LRREC,U,9)=$P(LRREC,U,9)+LRSOT ;LMIP field #8
 S $P(LRREC,U,12)=$P(LRREC,U,12)+LRREP ;Repeats
 S $P(LRREC,U,13)=$P(LRREC,U,13)+LRMAN ;Manual Inputs
 S $P(LRREC,U,14)=$P(LRREC,U,14)+$G(LRMII) ;Micro Inp
 S $P(LRREC,U,15)=$P(LRREC,U,15)+$G(LRMIO) ;Micro Out
 S $P(LRREC,U,16)=$P(LRREC,U,16)+LRSOTI ; In Pat stats
 S $P(LRREC,U,17)=$P(LRREC,U,17)+LROTHER ; Others
 S ^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE)=LRREC
 ;Also bump subtotal counts
 S LRREC2=$G(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0))
 S $P(LRREC2,U)=$P(LRREC2,U)+LRIPOT
 S $P(LRREC2,U,2)=$P(LRREC2,U,2)+LROPOT
 S $P(LRREC2,U,3)=$P(LRREC2,U,3)+LRNPOT
 S $P(LRREC2,U,4)=$P(LRREC2,U,4)+LRTOT
 S $P(LRREC2,U,5)=$P(LRREC2,U,5)+LRQC
 S $P(LRREC2,U,6)=$P(LRREC2,U,6)+LRTOST
 S $P(LRREC2,U,7)=$P(LRREC2,U,7)+LRSOOT
 S $P(LRREC2,U,8)=$P(LRREC2,U,8)+LROSOT
 S $P(LRREC2,U,9)=$P(LRREC2,U,9)+LRSOT
 S $P(LRREC2,U,12)=$P(LRREC2,U,12)+LRREP ;Repeats
 S $P(LRREC2,U,13)=$P(LRREC2,U,13)+LRMAN ;Manual Inputs
 S $P(LRREC2,U,14)=$P(LRREC2,U,14)+$G(LRMII) ;Micro Inp
 S $P(LRREC2,U,15)=$P(LRREC2,U,15)+$G(LRMIO) ;Micro Out
 S $P(LRREC2,U,16)=$P(LRREC2,U,16)+LRSOTI ; In Pat stats
 S $P(LRREC2,U,17)=$P(LRREC2,U,17)+LROTHER ; Others
 S ^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0)=LRREC2
 ;Also bump grand total counts
 S LRREC3=$G(^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP"))
 S $P(LRREC3,U)=$P(LRREC3,U)+LRIPOT
 S $P(LRREC3,U,2)=$P(LRREC3,U,2)+LROPOT
 S $P(LRREC3,U,3)=$P(LRREC3,U,3)+LRNPOT
 S $P(LRREC3,U,4)=$P(LRREC3,U,4)+LRTOT
 S $P(LRREC3,U,5)=$P(LRREC3,U,5)+LRQC
 S $P(LRREC3,U,6)=$P(LRREC3,U,6)+LRTOST
 S $P(LRREC3,U,7)=$P(LRREC3,U,7)+LRSOOT
 S $P(LRREC3,U,8)=$P(LRREC3,U,8)+LROSOT
 S $P(LRREC3,U,9)=$P(LRREC3,U,9)+LRSOT
 S $P(LRREC3,U,12)=$P(LRREC3,U,12)+LRREP ;Repeats
 S $P(LRREC3,U,13)=$P(LRREC3,U,13)+LRMAN ;Manual Inputs
 S $P(LRREC3,U,14)=$P(LRREC3,U,14)+$G(LRMII) ;Micro Inp
 S $P(LRREC3,U,15)=$P(LRREC3,U,15)+$G(LRMIO) ;Micro Out
 S $P(LRREC3,U,16)=$P(LRREC3,U,16)+LRSOTI ; In Pat stats
 S $P(LRREC3,U,17)=$P(LRREC3,U,17)+LROTHER ; Others
 S ^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP")=LRREC3
 Q
GETDA ;Get lab division and area
 N LRPTR,LRREC3
 S LRSKIP=1
 Q:'$G(LRCAPIFN)  Q:'$P($G(^LAM(LRCAPIFN,0)),U,5)
 S LRPTR=+$P($G(^LAM(LRCAPIFN,0)),U,15)
 S:'LRPTR LRPTR=1
 S LRREC3=$G(^LAB(64.21,LRPTR,0))
 Q:'$L(LRREC3)
 S LRLDIV=$P(LRREC3,U,4)
 Q:'$L(LRLDIV)
 S LRLARE=$P(LRREC3,U)
 Q:'$L(LRLARE)
 S LRSKIP=0
 Q