Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRCAPAM7

LRCAPAM7.m

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