source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRPCE3.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 5.0 KB
Line 
1PXRRPCE3 ;HIN/MjK - Clinic Specific Workload Reports ;6/7/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**121,146**;;Aug 12, 1996
3EN ;_._._._._._._.Visit Totals/ Patient Ages/ Unsched Totals_._._._._._.
4 ; Z = Visit Dt/Time
5 D INITVAR^PXRRPCE5 ;Initialize counter variables
6 S (X,Y)=0 F S X=$O(PXRRCLIN(X)) Q:'X S Y=Y+1,PXRCLNUM=Y
7 S PXRRY=PXRRYR F S PXRRY=$O(^AUPNVSIT("B",PXRRY)) Q:'PXRRY!((PXRRY>PXRREDT)) S PXRRVIFN=0 F S PXRRVIFN=$O(^AUPNVSIT("B",PXRRY,PXRRVIFN)) Q:'PXRRVIFN I $P($G(^AUPNVSIT(PXRRVIFN,0)),U,22)=PXRRCLIN D
8 . S X=$P($G(^AUPNVSIT(PXRRVIFN,0)),U,7) Q:X'="A"&(X'="I")&(X'="S")
9 . S Z=$P(^AUPNVSIT(PXRRVIFN,0),U),DFN=$P(^AUPNVSIT(PXRRVIFN,0),U,5)
10 . ;_._._._._._._._.Demographics - Sessions, Ages_._._._._._._._.
11 . S PXRRTVS=PXRRTVS+1 I Z>PXRRBDT S PXRRSESS=$S($D(Z($P(Z,"."))):PXRRSESS,1:PXRRSESS+1),Z($P(Z,"."))=""
12 . D AGE
13 . ;_._._._._._._._._._All Clinic Patients_._._._._._._._._._
14 . S PXRRAPT=$P(Z,".") F S PXRRAPT=$O(^DPT(DFN,"S",PXRRAPT)) Q:'PXRRAPT!(PXRRAPT>($$FMADD^XLFDT(PXRRAPT,1))) I $P(^DPT(DFN,"S",PXRRAPT,0),U)=PXRRCLIN S:$P(^DPT(DFN,"S",PXRRAPT,0),U,7)=4 PXRRSXUN=PXRRSXUN+1
15 . S ^TMP($J,PXRRCLIN,"PATIENT APPTS",Z,DFN)=""
16 . S ^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)=""
17 . ;_._._._._._._._._._._._._Diagnoses_._._._._._._._._._._._._.
18 . ;B = V POV IEN ; C = ICD Code
19 . ;S B="" F S B=$O(^AUPNVPOV("AD",PXRRVIFN,B)) Q:'B S C=$P(^ICD9($P(^AUPNVPOV(B,0),U),0),U),C=$S('+C:C,1:+C) S:(C'?1"272.".E)&(C'?1"305.".E) C=$P(C,".") S ^TMP($J,PXRRCLIN,"ICD",Z,C,DFN)="",^TMP($J,PXRRCLIN,"ICD PAT",C,DFN,Z""
20 . S B="" F S B=$O(^AUPNVPOV("AD",PXRRVIFN,B)) Q:'B S C=$P($$ICDDX^ICDCODE($P(^AUPNVPOV(B,0),U)),U,2),C=$S('+C:C,1:+C) S:(C'?1"272.".E)&(C'?1"305.".E) C=$P(C,".") S ^TMP($J,PXRRCLIN,"ICD",Z,C,DFN)="",^TMP($J,PXRRCLIN,"ICD PAT",C,DFN,Z)=""
21MEDAGE ;_._._._._._._._._._._._._._Median Age_._._._._._._._._._._._._._._.
22 S X=0 F S X=$O(^TMP($J,PXRRCLIN,"PATIENT AGE",X)) Q:'X S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"PATIENT AGE",X,DFN)) Q:'DFN D
23 . S Y=$G(^TMP($J,PXRRCLIN,"PATIENT AGE",X,DFN))
24 . I (Y>PXRRBDT),(Y<PXRREDT) S PXRRAGE=PXRRAGE+1,Y(PXRRAGE)=X
25 S PXRRAGE=PXRRAGE\2,PXRRAG=$G(Y(PXRRAGE)) K Y
26 ;_._._._._._._._._._._._._._Diagnosis Totals_._._._._._._._._._._._._.
27 ;C = ICD ;E = date
28 Q:'$D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS"))!'(PXRRSESS)
29 F C=272.2,272.4,250,401,414,305.1 S PXRR(C)=0
30 S E=0 F S E=$O(^TMP($J,PXRRCLIN,"ICD",E)) Q:'E I $D(^TMP($J,PXRRCLIN,"ICD",E,C)) S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"ICD",E,C,DFN)) Q:'DFN S PXRR(C)=$S('$D(C(DFN)):PXRR(C)+1,1:PXRR(C)),C(DFN)=""
31 K C S E=PXRRBDT F S E=$O(^TMP($J,PXRRCLIN,"ICD",E)) Q:'E!(E>PXRREDT) S C=0 F S C=$O(^TMP($J,PXRRCLIN,"ICD",E,C)) Q:'C S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"ICD",E,C,DFN)) Q:'DFN D
32 . I '$D(PXRR(C)) S PXRR(C)=0
33 . S PXRR(C)=$S('$D(C(C,DFN)):PXRR(C)+1,1:0),C(C,DFN)=""
34 K C S PXRR(272)=PXRR(272.4)+$G(PXRR(272.2)),PXRR(305)=0 F C=305.1:.01:305.13 S PXRR(305)=PXRR(305)+$G(PXRR(C))
35 S PXRRDM=$G(PXRR(250)),PXRRHTN=$G(PXRR(401)),PXRRCAD=$G(PXRR(414)),PXRRHLIP=PXRR(272),PXRRSMYR=PXRR(305)
36 ;_._._._._._._._._.Diabetes and Hypertensive Patients_._._._._._._._.
37 S PXRRHTDM=0,E=PXRRBDT F S E=$O(^TMP($J,PXRRCLIN,"ICD",E)) Q:'E!(E>PXRREDT) S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"ICD",E,250,DFN)) Q:'DFN I $D(^TMP($J,PXRRCLIN,"ICD PAT",401,DFN)) D
38 . S X=PXRRBDT F S X=$O(^TMP($J,PXRRCLIN,"ICD PAT",401,DFN,X)) Q:'X I X<PXRREDT S PXRRHTDM=PXRRHTDM+1
39 ; _._._._._._._._._._._Smokers with CAD DX_._._._._._._._._._._._._.
40 S PXRRCDSM=0,C=304 F S C=$O(^TMP($J,PXRRCLIN,"ICD PAT",C)) Q:'C!(C>305.13) S DFN=0 F S DFN=$O(^(C,DFN)) Q:'DFN S E=PXRRSXMO F S E=$O(^(C,DFN,E)) Q:'E I $D(^TMP($J,PXRRCLIN,"ICD PAT",414,DFN)) S PXRRCDSM=PXRRCDSM+1
41HBA1 ; _._._._._._._._._._.HTN AND/OR HBA1C w/ DM DX_._._._._._._._._._._._.
42 ; **Site Specific Entries for Selected Labs**
43 S PX=$O(^PX(815,0)),C=250,(DFN,PXRRHBA1)=0,PXRRLED=(9999999.9999999-PXRRSXMO) F S DFN=$O(^TMP($J,PXRRCLIN,"ICD PAT",C,DFN)) Q:'DFN D
44 . S PXRLRDFN=$P($G(^DPT(DFN,"LR")),U) Q:'PXRLRDFN S L=0 F S L=$O(^PX(815,PX,"RR5",L)) Q:'L S X=$P(^(L,0),U),X=$P($P(^LAB(60,X,0),U,5),";",2),E=9999999.9999999-DT F S E=$O(^LR(PXRLRDFN,"CH",E)) Q:'E!(E>PXRRLED) D
45 .. S:+$P($G(^LR(PXRLRDFN,"CH",E,X)),U) PXRRHBA1=PXRRHBA1+$P($G(^LR(PXRLRDFN,"CH",E,X)),U),^TMP($J,PXRRCLIN,"HBA1C",DFN,E)=$P($G(^LR(PXRLRDFN,"CH",E,X)),U)
46 S (PXRRHBG7,PXRRHBPT,DFN)=0 F S DFN=$O(^TMP($J,PXRRCLIN,"HBA1C",DFN)) Q:'DFN S X=0 F S X=$O(^TMP($J,PXRRCLIN,"HBA1C",DFN,X)) Q:'X S PXRRHBPT=PXRRHBPT+1 D
47 . I $G(^TMP($J,PXRRCLIN,"HBA1C",DFN,X))>6.99,'$D(X(DFN)) S PXRRHBG7=PXRRHBG7+1
48 . S X(DFN)=""
49 K X I $G(PXRRHBA1)>0 S PXRRHBA1=PXRRHBA1/PXRRHBPT
50 S:'PXRRHBPT PXRRHBA1="N/A",PXRRHBG7=0
51SXUTTOT ;_._._._._._._._._.Quality Care & Util 7 other Totals_._._._._._._._.
52 D ^PXRRPCE4
53 I '$D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS")) S ^TMP($J,PXRRCLIN,"PATIENT","NONE",PXRRCLIN)=""
54QT Q
55AGE ;_._._._._._._._._._.Calculate a patient's age_._._._._._._._._._.
56 I $D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) S X=0 Q
57 D DEM^VADPT I VADM(4) S ^TMP($J,PXRRCLIN,"PATIENT AGE",VADM(4),DFN)=Z D KVAR^VADPT
58 Q
Note: See TracBrowser for help on using the repository browser.