- 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
- PXRRPCE4 ;HIN/MjK - Clinic Specific Caseload Demographics ;6/7/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- LDL ;_._._._._._._._._._._._._._.LDL w/ CAD DX _._._._._.__._._._._._._._.
- +1 ; **Site Specific IENS from Laboratory Test file**
- +2 ;E=lab dt ;L=lab test ifn ;V=ldl value
- +3 SET PX=$ORDER(^PX(815,0))
- +4 SET C=414
- SET (PXRRLDL,PXRRDFN,PXRRCDSX,PXRRLDPT)=0
- FOR
- SET PXRRDFN=$ORDER(^TMP($JOB,PXRRCLIN,"ICD PAT",C,PXRRDFN))
- IF 'PXRRDFN
- QUIT
- SET PXRRCDSX=PXRRCDSX+1
- SET PXRLRDFN=+$GET(^DPT(PXRRDFN,"LR"))
- IF 'PXRLRDFN
- QUIT
- SET E=0
- FOR
- SET E=$ORDER(^LR(PXRLRDFN,"CH",E))
- IF 'E!(E>PXRRLED)
- QUIT
- Begin DoDot:1
- +5 SET X=0
- FOR
- SET X=$ORDER(^PX(815,PX,"RR4",X))
- IF 'X
- QUIT
- SET L=$PIECE(^PX(815,PX,"RR4",X,0),U)
- SET L=$PIECE($PIECE(^LAB(60,L,0),U,5),";",2)
- IF $DATA(^LR(PXRLRDFN,"CH",E,L))
- Begin DoDot:2
- +6 SET V=+$PIECE($GET(^LR(PXRLRDFN,"CH",E,L)),U)
- +7 SET PXRRLDL=PXRRLDL+V
- +8 IF +V
- SET PXRRLDPT=PXRRLDPT+1
- SET ^TMP($JOB,"LDL",PXRRDFN,E)=V
- +9 IF '+V
- SET ^TMP($JOB,"LDL NO VAL",PXRRDFN,E)=V
- End DoDot:2
- End DoDot:1
- +10 IF $GET(PXRRLDL)>0
- SET PXRRLDL=PXRRLDL/PXRRLDPT
- +11 ;_._.CAD pats with no LDL values_._.
- +12 SET (PXRRNOLD,PXRRDFN)=0
- FOR
- SET PXRRDFN=$ORDER(^TMP($JOB,"ICD PAT",C,PXRRDFN))
- IF 'PXRRDFN
- QUIT
- IF '$DATA(^TMP($JOB,"LDL",PXRRDFN))
- SET PXRRNOLD=PXRRNOLD+1
- +13 IF '+PXRRLDPT
- SET PXRRLDL="N/A"
- TOTPATS ;_._._._._._._._._.Patient Totals - Pats by Gender_._._._._._._._._.
- +1 SET PRX=0
- FOR
- SET PRX=$ORDER(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",PRX))
- IF 'PRX
- QUIT
- SET PXRRTPAT=PXRRTPAT+1
- SET DFN=PRX
- DO DEM^VADPT
- KILL DFN
- IF $PIECE(VADM(5),U)="M"
- SET PXRRMPAT=PXRRMPAT+1
- +2 SET PXRRFPAT=PXRRTPAT-PXRRMPAT
- SET PXRRRTVS=0
- SET X=0
- SET Y=""
- FOR
- SET X=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT APPTS",X))
- IF 'X
- QUIT
- SET PXRRDFN=0
- FOR
- SET PXRRDFN=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT APPTS",X,PXRRDFN))
- IF 'PXRRDFN
- QUIT
- Begin DoDot:1
- +3 IF (X>PXRRBDT)&'($DATA(X(PXRRDFN)))
- SET PXRRVPAT=PXRRVPAT+1
- SET X(PXRRDFN)=""
- +4 IF (X'<PXRRSXMO)&('$DATA(Y(PXRRDFN)))
- SET PXRRQPAT=PXRRQPAT+1
- SET Y(PXRRDFN)=""
- +5 IF X'>PXRREDT&(X>PXRRBDT)
- SET PXRRRTVS=PXRRRTVS+1
- End DoDot:1
- +6 KILL X,Y
- SET PXRRPTSS=PXRRRTVS/PXRRSESS
- QLM ;_._._._._._._._._.QLM Unsched, ER, Hospztns_._._._._._._._._.
- +1 ; ** Site Specific Clinic IENs from file 44**
- +2 SET PX=$ORDER(^PX(815,0))
- SET (DFN,PXRRSXER,PXRRSXHP)=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +3 SET Y=0
- FOR
- SET Y=$ORDER(^PX(815,PX,"RR1",Y))
- IF 'Y
- QUIT
- SET PXRRER=$PIECE(^(Y,0),U)
- SET VASD("C",PXRRER)=""
- +4 SET VASD("F")=PXRRBDT
- SET VASD("T")=PXRRSXMO
- DO SDA^VADPT
- SET X=0
- FOR
- SET X=$ORDER(^UTILITY("VASD",$JOB,X))
- IF 'X
- QUIT
- SET PXRRSXER=PXRRSXER+1
- +5 SET PXRRDIFF=$$FMDIFF^XLFDT(PXRRBDT,PXRRSXMO)
- FOR PXR=0:1:PXRRDIFF
- SET VAINDT=$$FMADD^XLFDT(PXRRBDT,PXR)
- DO ADM^VADPT2
- IF $GET(VADMVT)'=""
- IF '$DATA(PXR(VADMVT))
- SET PXRRSXHP=PXRRSXHP+1
- SET PXR(VADMVT)=""
- KILL VADMVT
- End DoDot:1
- +6 KILL PXR
- PERQPAT IF PXRRQPAT>0
- FOR PXRR="PXRRSXUN","PXRRSXER","PXRRSXHP"
- SET Y=@PXRR
- SET PXRR(PXRR)=$SELECT('Y:0,1:(Y/PXRRQPAT))
- MAMGRM ;_._._._._._._._._._Mammograms for Patients >= 50 _._._._._.__._._.
- +1 ;PXRRA = Age in years ;B= Radiology Date ;C = Inv. Radiology Date
- +2 ;E = IEN2 RADIOLOGY PATIENT
- +3 SET (PXRRF50,PXRRMMYR)=0
- SET PXRRA=49.9
- +4 FOR
- SET PXRRA=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT AGE",PXRRA))
- IF 'PXRRA
- QUIT
- SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT AGE",PXRRA,DFN))
- IF 'DFN
- QUIT
- DO DEM^VADPT
- IF $PIECE(VADM(5),U)="F"
- SET PXRRF50=PXRRF50+1
- IF $DATA(^RADPT(DFN))
- Begin DoDot:1
- +5 SET B=PXRRBDT
- FOR
- SET B=$ORDER(^RADPT(DFN,"DT",B))
- IF 'B!((9999999.9999999-B)<PXRRYR)
- QUIT
- SET E=0
- FOR
- SET E=$ORDER(^RADPT(DFN,"DT",B,"P",E))
- IF 'E
- QUIT
- IF '$DATA(E(DFN))
- Begin DoDot:2
- +6 SET PXRRMAMG=$PIECE($GET(^RADPT(DFN,"DT",B,"P",E,0)),U,2)
- IF PXRRMAMG
- FOR X=76090:1:76092
- IF $DATA(^RAMIS(71,"D",X,PXRRMAMG))
- SET PXRRMMYR=PXRRMMYR+1
- SET ^TMP($JOB,PXRRCLIN,">=50 W MM",DFN,B)=""
- SET E(DFN)=""
- End DoDot:2
- End DoDot:1
- +7 KILL E
- CRITLAB ;_._._._._._._._._._._.Critical Lab Values_._._._._._._._._._._._.
- +1 ;X = Lab Fields E = Lab Date ;C = Chol Value G = Glucose Value
- +2 SET (PXRRDFN,PXRRGL,PXRRCHOL)=0
- +3 FOR
- SET PXRRDFN=$ORDER(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",PXRRDFN))
- IF 'PXRRDFN
- QUIT
- SET PXRLRDFN=+$GET(^DPT(PXRRDFN,"LR"))
- IF 'PXRLRDFN
- QUIT
- SET L=0
- FOR
- SET L=$ORDER(^PX(815,PX,"RR2",L))
- IF 'L
- QUIT
- SET X=$PIECE(^(L,0),U)
- SET X=$PIECE($PIECE(^LAB(60,X,0),U,5),";",2)
- Begin DoDot:1
- GLU ;_.Glucose
- +1 SET E=0
- FOR
- SET E=$ORDER(^LR(PXRLRDFN,"CH",E))
- IF 'E!(E>PXRRLED)
- QUIT
- SET C=+$PIECE($GET(^LR(PXRLRDFN,"CH",E,+X)),U)
- IF C>200&('$DATA(^TMP($JOB,PXRRCLIN,"GL",PXRRDFN)))
- SET PXRRGL=PXRRGL+1
- SET ^TMP($JOB,PXRRCLIN,"GL",PXRRDFN,C,E)=""
- CHOL ;_.Cholesterol
- +1 SET L=0
- FOR
- SET L=$ORDER(^PX(815,PX,"RR3",L))
- IF 'L
- QUIT
- SET X=$PIECE(^(L,0),U)
- SET X=$PIECE($PIECE(^LAB(60,X,0),U,5),";",2)
- Begin DoDot:2
- +2 FOR
- SET E=$ORDER(^LR(PXRLRDFN,"CH",E))
- IF 'E!(E>PXRRLED)
- QUIT
- SET G=+$PIECE($GET(^LR(PXRLRDFN,"CH",E,+X)),U)
- IF G>240&('$DATA(^TMP($JOB,PXRRCLIN,"CHOL",PXRRDFN)))
- SET PXRRCHOL=PXRRCHOL+1
- SET ^TMP($JOB,PXRRCLIN,"CHOL",PXRRDFN,G,E)=""
- End DoDot:2
- End DoDot:1
- UTIL ;._._._._._._._._._._._._.Utilization Data_._._._._._._._._._._._.
- +1 SET DFN=0
- FOR
- SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",DFN))
- IF 'DFN
- QUIT
- Begin DoDot:1
- +2 SET PSOACT=1
- DO ^PSOHCSUM
- SET PXRRPSO=0
- FOR
- SET PXRRPSO=$ORDER(^TMP("PSOO",$JOB,PXRRPSO))
- IF 'PXRRPSO
- QUIT
- IF $PIECE($PIECE(^TMP("PSOO",$JOB,PXRRPSO,0),U,5),";",2)="ACTIVE"
- SET PXRRPSUT=PXRRPSUT+1
- SET PXRRCOST=PXRRCOST+$PIECE(^TMP("PSOO",$JOB,PXRRPSO,0),U,10)
- +3 KILL ^TMP("PSOO",$JOB)
- End DoDot:1
- +4 SET PXRRUTVS=PXRRTVS/PXRRTPAT
- SET PXRRUTVS=$JUSTIFY(PXRRUTVS,2,1)
- PERUPAT IF PXRRTPAT>0
- FOR PXRR="PXRRPSUT","PXRRCOST"
- SET Y=@PXRR
- SET PXRR(PXRR)=$SELECT('Y:0,1:(Y/PXRRTPAT))
- PCE5 ;_._._._._._._._._._._._.Call PXRRPCE5_._._._._._._._._._._._.
- +1 DO ^PXRRPCE5
- +2 QUIT
