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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1PXRRPCE4 ;HIN/MjK - Clinic Specific Caseload Demographics ;6/7/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
3LDL ;_._._._._._._._._._._._._._.LDL w/ CAD DX _._._._._.__._._._._._._._.
4 ; **Site Specific IENS from Laboratory Test file**
5 ;E=lab dt ;L=lab test ifn ;V=ldl value
6 S PX=$O(^PX(815,0))
7 S C=414,(PXRRLDL,PXRRDFN,PXRRCDSX,PXRRLDPT)=0 F S PXRRDFN=$O(^TMP($J,PXRRCLIN,"ICD PAT",C,PXRRDFN)) Q:'PXRRDFN S PXRRCDSX=PXRRCDSX+1,PXRLRDFN=+$G(^DPT(PXRRDFN,"LR")) Q:'PXRLRDFN S E=0 F S E=$O(^LR(PXRLRDFN,"CH",E)) Q:'E!(E>PXRRLED) D
8 . S X=0 F S X=$O(^PX(815,PX,"RR4",X)) Q:'X S L=$P(^PX(815,PX,"RR4",X,0),U),L=$P($P(^LAB(60,L,0),U,5),";",2) I $D(^LR(PXRLRDFN,"CH",E,L)) D
9 .. S V=+$P($G(^LR(PXRLRDFN,"CH",E,L)),U)
10 .. S PXRRLDL=PXRRLDL+V
11 .. S:+V PXRRLDPT=PXRRLDPT+1,^TMP($J,"LDL",PXRRDFN,E)=V
12 .. S:'+V ^TMP($J,"LDL NO VAL",PXRRDFN,E)=V
13 I $G(PXRRLDL)>0 S PXRRLDL=PXRRLDL/PXRRLDPT
14 ;_._.CAD pats with no LDL values_._.
15 S (PXRRNOLD,PXRRDFN)=0 F S PXRRDFN=$O(^TMP($J,"ICD PAT",C,PXRRDFN)) Q:'PXRRDFN I '$D(^TMP($J,"LDL",PXRRDFN)) S PXRRNOLD=PXRRNOLD+1
16 I '+PXRRLDPT S PXRRLDL="N/A"
17TOTPATS ;_._._._._._._._._.Patient Totals - Pats by Gender_._._._._._._._._.
18 S PRX=0 F S PRX=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",PRX)) Q:'PRX S PXRRTPAT=PXRRTPAT+1 S DFN=PRX D DEM^VADPT K DFN I $P(VADM(5),U)="M" S PXRRMPAT=PXRRMPAT+1
19 S PXRRFPAT=PXRRTPAT-PXRRMPAT,PXRRRTVS=0,X=0,Y="" F S X=$O(^TMP($J,PXRRCLIN,"PATIENT APPTS",X)) Q:'X S PXRRDFN=0 F S PXRRDFN=$O(^TMP($J,PXRRCLIN,"PATIENT APPTS",X,PXRRDFN)) Q:'PXRRDFN D
20 . S:(X>PXRRBDT)&'($D(X(PXRRDFN))) PXRRVPAT=PXRRVPAT+1,X(PXRRDFN)=""
21 . S:(X'<PXRRSXMO)&('$D(Y(PXRRDFN))) PXRRQPAT=PXRRQPAT+1,Y(PXRRDFN)=""
22 . S:X'>PXRREDT&(X>PXRRBDT) PXRRRTVS=PXRRRTVS+1
23 K X,Y S PXRRPTSS=PXRRRTVS/PXRRSESS
24QLM ;_._._._._._._._._.QLM Unsched, ER, Hospztns_._._._._._._._._.
25 ; ** Site Specific Clinic IENs from file 44**
26 S PX=$O(^PX(815,0)),(DFN,PXRRSXER,PXRRSXHP)=0 F S DFN=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) Q:'DFN D
27 . S Y=0 F S Y=$O(^PX(815,PX,"RR1",Y)) Q:'Y S PXRRER=$P(^(Y,0),U),VASD("C",PXRRER)=""
28 . S VASD("F")=PXRRBDT,VASD("T")=PXRRSXMO D SDA^VADPT S X=0 F S X=$O(^UTILITY("VASD",$J,X)) Q:'X S PXRRSXER=PXRRSXER+1
29 . S PXRRDIFF=$$FMDIFF^XLFDT(PXRRBDT,PXRRSXMO) F PXR=0:1:PXRRDIFF S VAINDT=$$FMADD^XLFDT(PXRRBDT,PXR) D ADM^VADPT2 I $G(VADMVT)'="" S:'$D(PXR(VADMVT)) PXRRSXHP=PXRRSXHP+1 S PXR(VADMVT)="" K VADMVT
30 K PXR
31PERQPAT I PXRRQPAT>0 F PXRR="PXRRSXUN","PXRRSXER","PXRRSXHP" S Y=@PXRR S PXRR(PXRR)=$S('Y:0,1:(Y/PXRRQPAT))
32MAMGRM ;_._._._._._._._._._Mammograms for Patients >= 50 _._._._._.__._._.
33 ;PXRRA = Age in years ;B= Radiology Date ;C = Inv. Radiology Date
34 ;E = IEN2 RADIOLOGY PATIENT
35 S (PXRRF50,PXRRMMYR)=0,PXRRA=49.9
36 F S PXRRA=$O(^TMP($J,PXRRCLIN,"PATIENT AGE",PXRRA)) Q:'PXRRA S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"PATIENT AGE",PXRRA,DFN)) Q:'DFN D DEM^VADPT I $P(VADM(5),U)="F" S PXRRF50=PXRRF50+1 I $D(^RADPT(DFN)) D
37 . S B=PXRRBDT F S B=$O(^RADPT(DFN,"DT",B)) Q:'B!((9999999.9999999-B)<PXRRYR) S E=0 F S E=$O(^RADPT(DFN,"DT",B,"P",E)) Q:'E D:'$D(E(DFN))
38 .. S PXRRMAMG=$P($G(^RADPT(DFN,"DT",B,"P",E,0)),U,2) I PXRRMAMG F X=76090:1:76092 S:$D(^RAMIS(71,"D",X,PXRRMAMG)) PXRRMMYR=PXRRMMYR+1,^TMP($J,PXRRCLIN,">=50 W MM",DFN,B)="",E(DFN)=""
39 K E
40CRITLAB ;_._._._._._._._._._._.Critical Lab Values_._._._._._._._._._._._.
41 ;X = Lab Fields E = Lab Date ;C = Chol Value G = Glucose Value
42 S (PXRRDFN,PXRRGL,PXRRCHOL)=0
43 F S PXRRDFN=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",PXRRDFN)) Q:'PXRRDFN S PXRLRDFN=+$G(^DPT(PXRRDFN,"LR")) Q:'PXRLRDFN S L=0 F S L=$O(^PX(815,PX,"RR2",L)) Q:'L S X=$P(^(L,0),U),X=$P($P(^LAB(60,X,0),U,5),";",2) D
44GLU . ;_.Glucose
45 . S E=0 F S E=$O(^LR(PXRLRDFN,"CH",E)) Q:'E!(E>PXRRLED) S C=+$P($G(^LR(PXRLRDFN,"CH",E,+X)),U) S:C>200&('$D(^TMP($J,PXRRCLIN,"GL",PXRRDFN))) PXRRGL=PXRRGL+1,^TMP($J,PXRRCLIN,"GL",PXRRDFN,C,E)=""
46CHOL . ;_.Cholesterol
47 . S L=0 F S L=$O(^PX(815,PX,"RR3",L)) Q:'L S X=$P(^(L,0),U),X=$P($P(^LAB(60,X,0),U,5),";",2) D
48 .. F S E=$O(^LR(PXRLRDFN,"CH",E)) Q:'E!(E>PXRRLED) S G=+$P($G(^LR(PXRLRDFN,"CH",E,+X)),U) S:G>240&('$D(^TMP($J,PXRRCLIN,"CHOL",PXRRDFN))) PXRRCHOL=PXRRCHOL+1,^TMP($J,PXRRCLIN,"CHOL",PXRRDFN,G,E)=""
49UTIL ;._._._._._._._._._._._._.Utilization Data_._._._._._._._._._._._.
50 S DFN=0 F S DFN=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) Q:'DFN D
51 . S PSOACT=1 D ^PSOHCSUM S PXRRPSO=0 F S PXRRPSO=$O(^TMP("PSOO",$J,PXRRPSO)) Q:'PXRRPSO I $P($P(^TMP("PSOO",$J,PXRRPSO,0),U,5),";",2)="ACTIVE" S PXRRPSUT=PXRRPSUT+1,PXRRCOST=PXRRCOST+$P(^TMP("PSOO",$J,PXRRPSO,0),U,10)
52 . K ^TMP("PSOO",$J)
53 S PXRRUTVS=PXRRTVS/PXRRTPAT,PXRRUTVS=$J(PXRRUTVS,2,1)
54PERUPAT I PXRRTPAT>0 F PXRR="PXRRPSUT","PXRRCOST" S Y=@PXRR S PXRR(PXRR)=$S('Y:0,1:(Y/PXRRTPAT))
55PCE5 ;_._._._._._._._._._._._.Call PXRRPCE5_._._._._._._._._._._._.
56 D ^PXRRPCE5
57 Q
Note: See TracBrowser for help on using the repository browser.