source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRCAPAM7.m@ 1154

Last change on this file since 1154 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1LRCAPAM7 ;DALISC/J0 - RCS 14-4 REPORT, LMIP PAGE COUNTERS ;5/10/93
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3EN ;
4INITSUM ;
5 N LRIFN,LRREC,LRLARE,LRLDIV,I
6 S LRIFN=0
7 F S LRIFN=$O(^LAB(64.21,LRIFN)) Q:'LRIFN I LRIFN'=8 D
8 .S LRREC=$G(^LAB(64.21,LRIFN,0))
9 .Q:'$L(LRREC)
10 .S LRLDIV=$P(LRREC,U,4)
11 .Q:'$L(LRLDIV)
12 .S LRLARE=$P(LRREC,U)
13 .Q:'$L(LRLARE)
14 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0),U,I)=0
15 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE),U,I)=0
16 .F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE),U,I)=0
17 F I=1:1:20 S $P(^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP"),U,I)=0
18 Q
19BMPSUM ;
20 ;LRIPOT(2)=in-patient ; LROPOT(3)=outpatient ; LRNPOT(4)=other patients (REFERRAL)
21 ;LRQC=qc(5) ; LRTOST=total on site ; LRMAN(8)=manual input
22 ;LROTHER(12)=other ; LRSOOT(10)=send out flag ; LROSOT= total performed on-site test
23 ;LRSOT(7)=total stat ; LRSOTI(6)= total inpatient stat
24 ;LRTOT= total ordered test
25 ;LRREP(11)=std/reps LRMII=Micro In-house LRMIO=Micro Sendout
26 ;LRSUBF=suffix
27 N LRREP,LRREC,LRIPOT,LROPOT,LRNPOT,LRQC,LRSOT,LRMAN,LRSOOT,LROSOT,LRTOT,LRTOST
28 N LRREC2,LRREC3,LRSKIP,LRLDIV,LRLARE,LROTHER
29 N LRSOTI,LRMII,LRMIO,LRSUBF
30 S LRSOTI=$P(LRN,U,6),LRSUBF=$P($P(LRN,U),".",2)
31 S LRIPOT=+$P(LRN,U,2),LROPOT=+$P(LRN,U,3),LRNPOT=+$P(LRN,U,4)
32 S LRQC=+$P(LRN,U,5),LRSOT=+$P(LRN,U,7),LRMAN=+$P(LRN,U,8)
33 S LRSOOT=+$P(LRN,U,10),LRREP=$P(LRN,U,11),LROTHER=+$P(LRN,U,12)
34 S LROSOT=$S(LRSOOT:0,1:(LRIPOT+LROPOT+LRNPOT))
35 S LRTOT=LRIPOT+LROPOT+LRNPOT
36 S LRTOST=LRIPOT+LROPOT+LRNPOT+LRMAN+LRQC+LROTHER+LRREP
37 I $E(LRSUBF,3,4)="00" D
38 . I LRSUBF>8000,LRSUBF<9000,LRSUBF'=8500,LRSUBF'=8600 S LRMIO=LRTOT
39 . I LRSUBF>7000,LRSUBF<8000,LRSUBF'=7500,LRSUBF'=7600 S LRMII=LRTOT
40 . S:'$D(LRMIPER) LRMIPER="^"
41 . S $P(LRMIPER,U)=$P(LRMIPER,U)+$G(LRMIO),$P(LRMIPER,U,2)=$P(LRMIPER,U,2)+$G(LRMII)
42 D GETDA Q:LRSKIP
43 ;bump div/area counts
44 S LRREC=$G(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE))
45 S $P(LRREC,U)=$P(LRREC,U)+LRIPOT ;LMIP field #5
46 S $P(LRREC,U,2)=$P(LRREC,U,2)+LROPOT ;LMIP field #6
47 S $P(LRREC,U,3)=$P(LRREC,U,3)+LRNPOT ;LMIP field #7
48 S $P(LRREC,U,4)=$P(LRREC,U,4)+LRTOT ;LMIP field #1
49 S $P(LRREC,U,5)=$P(LRREC,U,5)+LRQC ;no LIMP field #
50 S $P(LRREC,U,6)=$P(LRREC,U,6)+LRTOST ;LMIP field #2
51 S $P(LRREC,U,7)=$P(LRREC,U,7)+LRSOOT ;LMIP field #4
52 S $P(LRREC,U,8)=$P(LRREC,U,8)+LROSOT ;LMIP field #3
53 S $P(LRREC,U,9)=$P(LRREC,U,9)+LRSOT ;LMIP field #8
54 S $P(LRREC,U,12)=$P(LRREC,U,12)+LRREP ;Repeats
55 S $P(LRREC,U,13)=$P(LRREC,U,13)+LRMAN ;Manual Inputs
56 S $P(LRREC,U,14)=$P(LRREC,U,14)+$G(LRMII) ;Micro Inp
57 S $P(LRREC,U,15)=$P(LRREC,U,15)+$G(LRMIO) ;Micro Out
58 S $P(LRREC,U,16)=$P(LRREC,U,16)+LRSOTI ; In Pat stats
59 S $P(LRREC,U,17)=$P(LRREC,U,17)+LROTHER ; Others
60 S ^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,LRLARE)=LRREC
61 ;Also bump subtotal counts
62 S LRREC2=$G(^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0))
63 S $P(LRREC2,U)=$P(LRREC2,U)+LRIPOT
64 S $P(LRREC2,U,2)=$P(LRREC2,U,2)+LROPOT
65 S $P(LRREC2,U,3)=$P(LRREC2,U,3)+LRNPOT
66 S $P(LRREC2,U,4)=$P(LRREC2,U,4)+LRTOT
67 S $P(LRREC2,U,5)=$P(LRREC2,U,5)+LRQC
68 S $P(LRREC2,U,6)=$P(LRREC2,U,6)+LRTOST
69 S $P(LRREC2,U,7)=$P(LRREC2,U,7)+LRSOOT
70 S $P(LRREC2,U,8)=$P(LRREC2,U,8)+LROSOT
71 S $P(LRREC2,U,9)=$P(LRREC2,U,9)+LRSOT
72 S $P(LRREC2,U,12)=$P(LRREC2,U,12)+LRREP ;Repeats
73 S $P(LRREC2,U,13)=$P(LRREC2,U,13)+LRMAN ;Manual Inputs
74 S $P(LRREC2,U,14)=$P(LRREC2,U,14)+$G(LRMII) ;Micro Inp
75 S $P(LRREC2,U,15)=$P(LRREC2,U,15)+$G(LRMIO) ;Micro Out
76 S $P(LRREC2,U,16)=$P(LRREC2,U,16)+LRSOTI ; In Pat stats
77 S $P(LRREC2,U,17)=$P(LRREC2,U,17)+LROTHER ; Others
78 S ^TMP($J,"LMIP",$P(LRMT,U,2),LRLDIV,0)=LRREC2
79 ;Also bump grand total counts
80 S LRREC3=$G(^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP"))
81 S $P(LRREC3,U)=$P(LRREC3,U)+LRIPOT
82 S $P(LRREC3,U,2)=$P(LRREC3,U,2)+LROPOT
83 S $P(LRREC3,U,3)=$P(LRREC3,U,3)+LRNPOT
84 S $P(LRREC3,U,4)=$P(LRREC3,U,4)+LRTOT
85 S $P(LRREC3,U,5)=$P(LRREC3,U,5)+LRQC
86 S $P(LRREC3,U,6)=$P(LRREC3,U,6)+LRTOST
87 S $P(LRREC3,U,7)=$P(LRREC3,U,7)+LRSOOT
88 S $P(LRREC3,U,8)=$P(LRREC3,U,8)+LROSOT
89 S $P(LRREC3,U,9)=$P(LRREC3,U,9)+LRSOT
90 S $P(LRREC3,U,12)=$P(LRREC3,U,12)+LRREP ;Repeats
91 S $P(LRREC3,U,13)=$P(LRREC3,U,13)+LRMAN ;Manual Inputs
92 S $P(LRREC3,U,14)=$P(LRREC3,U,14)+$G(LRMII) ;Micro Inp
93 S $P(LRREC3,U,15)=$P(LRREC3,U,15)+$G(LRMIO) ;Micro Out
94 S $P(LRREC3,U,16)=$P(LRREC3,U,16)+LRSOTI ; In Pat stats
95 S $P(LRREC3,U,17)=$P(LRREC3,U,17)+LROTHER ; Others
96 S ^TMP($J,"LMIP",$P(LRMT,U,2),"TOT-AP/CP")=LRREC3
97 Q
98GETDA ;Get lab division and area
99 N LRPTR,LRREC3
100 S LRSKIP=1
101 Q:'$G(LRCAPIFN) Q:'$P($G(^LAM(LRCAPIFN,0)),U,5)
102 S LRPTR=+$P($G(^LAM(LRCAPIFN,0)),U,15)
103 S:'LRPTR LRPTR=1
104 S LRREC3=$G(^LAB(64.21,LRPTR,0))
105 Q:'$L(LRREC3)
106 S LRLDIV=$P(LRREC3,U,4)
107 Q:'$L(LRLDIV)
108 S LRLARE=$P(LRREC3,U)
109 Q:'$L(LRLARE)
110 S LRSKIP=0
111 Q
Note: See TracBrowser for help on using the repository browser.