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

PXRRPCE4 ;HIN/MjK - Clinic Specific Caseload Demographics ;6/7/96
 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
LDL ;_._._._._._._._._._._._._._.LDL w/ CAD DX _._._._._.__._._._._._._._.
 ;        **Site Specific IENS from Laboratory Test file**
 ;E=lab dt  ;L=lab test ifn  ;V=ldl value
 S PX=$O(^PX(815,0))
 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
 .  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
 .. S V=+$P($G(^LR(PXRLRDFN,"CH",E,L)),U)
 .. S PXRRLDL=PXRRLDL+V
 .. S:+V PXRRLDPT=PXRRLDPT+1,^TMP($J,"LDL",PXRRDFN,E)=V
 .. S:'+V ^TMP($J,"LDL NO VAL",PXRRDFN,E)=V
 I $G(PXRRLDL)>0 S PXRRLDL=PXRRLDL/PXRRLDPT
 ;_._.CAD pats with no LDL values_._.
 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
 I '+PXRRLDPT S PXRRLDL="N/A"
TOTPATS ;_._._._._._._._._.Patient Totals - Pats by Gender_._._._._._._._._.
 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
 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
 . S:(X>PXRRBDT)&'($D(X(PXRRDFN))) PXRRVPAT=PXRRVPAT+1,X(PXRRDFN)=""
 . S:(X'<PXRRSXMO)&('$D(Y(PXRRDFN))) PXRRQPAT=PXRRQPAT+1,Y(PXRRDFN)=""
 . S:X'>PXRREDT&(X>PXRRBDT) PXRRRTVS=PXRRRTVS+1
 K X,Y S PXRRPTSS=PXRRRTVS/PXRRSESS
QLM ;_._._._._._._._._.QLM Unsched, ER, Hospztns_._._._._._._._._.
 ;             ** Site Specific Clinic IENs from file 44**
 S PX=$O(^PX(815,0)),(DFN,PXRRSXER,PXRRSXHP)=0 F  S DFN=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) Q:'DFN  D
 . S Y=0 F  S Y=$O(^PX(815,PX,"RR1",Y)) Q:'Y  S PXRRER=$P(^(Y,0),U),VASD("C",PXRRER)=""
 . 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
 . 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
 K PXR
PERQPAT I PXRRQPAT>0 F PXRR="PXRRSXUN","PXRRSXER","PXRRSXHP" S Y=@PXRR S PXRR(PXRR)=$S('Y:0,1:(Y/PXRRQPAT))
MAMGRM ;_._._._._._._._._._Mammograms for Patients >= 50 _._._._._.__._._.
 ;PXRRA = Age in years ;B= Radiology Date ;C = Inv. Radiology Date
 ;E = IEN2 RADIOLOGY PATIENT
 S (PXRRF50,PXRRMMYR)=0,PXRRA=49.9
 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
 .  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))
 .. 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)=""
 K E
CRITLAB ;_._._._._._._._._._._.Critical Lab Values_._._._._._._._._._._._.
 ;X = Lab Fields E = Lab Date ;C = Chol Value G = Glucose Value
 S (PXRRDFN,PXRRGL,PXRRCHOL)=0
 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
GLU . ;_.Glucose
 . 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)=""
CHOL .  ;_.Cholesterol
 .  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
 .. 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)=""
UTIL ;._._._._._._._._._._._._.Utilization Data_._._._._._._._._._._._.
 S DFN=0 F  S DFN=$O(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) Q:'DFN  D
 . 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)
 . K ^TMP("PSOO",$J)
 S PXRRUTVS=PXRRTVS/PXRRTPAT,PXRRUTVS=$J(PXRRUTVS,2,1)
PERUPAT I PXRRTPAT>0 F PXRR="PXRRPSUT","PXRRCOST" S Y=@PXRR S PXRR(PXRR)=$S('Y:0,1:(Y/PXRRTPAT))
PCE5 ;_._._._._._._._._._._._.Call PXRRPCE5_._._._._._._._._._._._.
 D ^PXRRPCE5
 Q