112 lines
4.6 KiB
Mathematica
112 lines
4.6 KiB
Mathematica
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
|