PXRRPCE3 ;HIN/MjK - Clinic Specific Workload Reports ;6/7/96
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
EN ;_._._._._._._.Visit Totals/ Patient Ages/ Unsched Totals_._._._._._.
; Z = Visit Dt/Time
D INITVAR^PXRRPCE5 ;Initialize counter variables
S (X,Y)=0 F S X=$O(PXRRCLIN(X)) Q:'X S Y=Y+1,PXRCLNUM=Y
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
. S X=$P($G(^AUPNVSIT(PXRRVIFN,0)),U,7) Q:X'="A"&(X'="I")&(X'="S")
. S Z=$P(^AUPNVSIT(PXRRVIFN,0),U),DFN=$P(^AUPNVSIT(PXRRVIFN,0),U,5)
. ;_._._._._._._._.Demographics - Sessions, Ages_._._._._._._._.
. S PXRRTVS=PXRRTVS+1 I Z>PXRRBDT S PXRRSESS=$S($D(Z($P(Z,"."))):PXRRSESS,1:PXRRSESS+1),Z($P(Z,"."))=""
. D AGE
. ;_._._._._._._._._._All Clinic Patients_._._._._._._._._._
. S PXRRAPT=$P(Z,".") F S PXRRAPT=$O(^DPT("S",DFN,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
. S ^TMP($J,PXRRCLIN,"PATIENT APPTS",Z,DFN)=""
. S ^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)=""
. ;_._._._._._._._._._._._._Diagnoses_._._._._._._._._._._._._.
. ;B = V POV IEN ; C = ICD Code
. 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)=""
MEDAGE ;_._._._._._._._._._._._._._Median Age_._._._._._._._._._._._._._._.
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
. S Y=$G(^TMP($J,PXRRCLIN,"PATIENT AGE",X,DFN))
. I (Y>PXRRBDT),(Y<PXRREDT) S PXRRAGE=PXRRAGE+1,Y(PXRRAGE)=X
S PXRRAGE=PXRRAGE\2,PXRRAG=$G(Y(PXRRAGE)) K Y
;_._._._._._._._._._._._._._Diagnosis Totals_._._._._._._._._._._._._.
;C = ICD ;E = date
Q:'$D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS"))!'(PXRRSESS)
F C=272.2,272.4,250,401,414,305.1 S PXRR(C)=0
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)=""
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
. I '$D(PXRR(C)) S PXRR(C)=0
. S PXRR(C)=$S('$D(C(C,DFN)):PXRR(C)+1,1:0),C(C,DFN)=""
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))
S PXRRDM=$G(PXRR(250)),PXRRHTN=$G(PXRR(401)),PXRRCAD=$G(PXRR(414)),PXRRHLIP=PXRR(272),PXRRSMYR=PXRR(305)
;_._._._._._._._._.Diabetes and Hypertensive Patients_._._._._._._._.
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
. S X=PXRRBDT F S X=$O(^TMP($J,PXRRCLIN,"ICD PAT",401,DFN,X)) Q:'X I X<PXRREDT S PXRRHTDM=PXRRHTDM+1
; _._._._._._._._._._._Smokers with CAD DX_._._._._._._._._._._._._.
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
HBA1 ; _._._._._._._._._._.HTN AND/OR HBA1C w/ DM DX_._._._._._._._._._._._.
; **Site Specific Entries for Selected Labs**
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
. 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
.. 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)
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
. I $G(^TMP($J,PXRRCLIN,"HBA1C",DFN,X))>6.99,'$D(X(DFN)) S PXRRHBG7=PXRRHBG7+1
. S X(DFN)=""
K X I $G(PXRRHBA1)>0 S PXRRHBA1=PXRRHBA1/PXRRHBPT
S:'PXRRHBPT PXRRHBA1="N/A",PXRRHBG7=0
SXUTTOT ;_._._._._._._._._.Quality Care & Util 7 other Totals_._._._._._._._.
D ^PXRRPCE4
I '$D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS")) S ^TMP($J,PXRRCLIN,"PATIENT","NONE",PXRRCLIN)=""
QT Q
AGE ;_._._._._._._._._._.Calculate a patient's age_._._._._._._._._._.
I $D(^TMP($J,PXRRCLIN,"CLINIC PATIENTS",DFN)) S X=0 Q
D DEM^VADPT I VADM(4) S ^TMP($J,PXRRCLIN,"PATIENT AGE",VADM(4),DFN)=Z D KVAR^VADPT
Q
PXRRPCE3 ;HIN/MjK - Clinic Specific Workload Reports ;6/7/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
EN ;_._._._._._._.Visit Totals/ Patient Ages/ Unsched Totals_._._._._._.
+1 ; Z = Visit Dt/Time
+2 ;Initialize counter variables
DO INITVAR^PXRRPCE5
+3 SET (X,Y)=0
FOR
SET X=$ORDER(PXRRCLIN(X))
IF 'X
QUIT
SET Y=Y+1
SET PXRCLNUM=Y
+4 SET PXRRY=PXRRYR
FOR
SET PXRRY=$ORDER(^AUPNVSIT("B",PXRRY))
IF 'PXRRY!((PXRRY>PXRREDT))
QUIT
SET PXRRVIFN=0
FOR
SET PXRRVIFN=$ORDER(^AUPNVSIT("B",PXRRY,PXRRVIFN))
IF 'PXRRVIFN
QUIT
IF $PIECE($GET(^AUPNVSIT(PXRRVIFN,0)),U,22)=PXRRCLIN
Begin DoDot:1
+5 SET X=$PIECE($GET(^AUPNVSIT(PXRRVIFN,0)),U,7)
IF X'="A"&(X'="I")&(X'="S")
QUIT
+6 SET Z=$PIECE(^AUPNVSIT(PXRRVIFN,0),U)
SET DFN=$PIECE(^AUPNVSIT(PXRRVIFN,0),U,5)
+7 ;_._._._._._._._.Demographics - Sessions, Ages_._._._._._._._.
+8 SET PXRRTVS=PXRRTVS+1
IF Z>PXRRBDT
SET PXRRSESS=$SELECT($DATA(Z($PIECE(Z,"."))):PXRRSESS,1:PXRRSESS+1)
SET Z($PIECE(Z,"."))=""
+9 DO AGE
+10 ;_._._._._._._._._._All Clinic Patients_._._._._._._._._._
+11 SET PXRRAPT=$PIECE(Z,".")
FOR
SET PXRRAPT=$ORDER(^DPT("S",DFN,PXRRAPT))
IF 'PXRRAPT!(PXRRAPT>($$FMADD^XLFDT(PXRRAPT,1)))
QUIT
IF $PIECE(^DPT(DFN,"S",PXRRAPT,0),U)=PXRRCLIN
IF $PIECE(^DPT(DFN,"S",PXRRAPT,0),U,7)=4
SET PXRRSXUN=PXRRSXUN+1
+12 SET ^TMP($JOB,PXRRCLIN,"PATIENT APPTS",Z,DFN)=""
+13 SET ^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",DFN)=""
+14 ;_._._._._._._._._._._._._Diagnoses_._._._._._._._._._._._._.
+15 ;B = V POV IEN ; C = ICD Code
+16 SET B=""
FOR
SET B=$ORDER(^AUPNVPOV("AD",PXRRVIFN,B))
IF 'B
QUIT
SET C=$PIECE(^ICD9($PIECE(^AUPNVPOV(B,0),U),0),U)
SET C=$SELECT('+C:C,1:+C)
IF (C'?1"272.".E)&(C'?1"305.".E)
SET C=$PIECE(C,".")
SET ^TMP($JOB,PXRRCLIN,"ICD",Z,C,DFN)=""
SET ^TMP($JOB,PXRRCLIN,"ICD PAT",C,DFN,Z)=""
End DoDot:1
MEDAGE ;_._._._._._._._._._._._._._Median Age_._._._._._._._._._._._._._._.
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT AGE",X))
IF 'X
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"PATIENT AGE",X,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+2 SET Y=$GET(^TMP($JOB,PXRRCLIN,"PATIENT AGE",X,DFN))
+3 IF (Y>PXRRBDT)
IF (Y<PXRREDT)
SET PXRRAGE=PXRRAGE+1
SET Y(PXRRAGE)=X
End DoDot:1
+4 SET PXRRAGE=PXRRAGE\2
SET PXRRAG=$GET(Y(PXRRAGE))
KILL Y
+5 ;_._._._._._._._._._._._._._Diagnosis Totals_._._._._._._._._._._._._.
+6 ;C = ICD ;E = date
+7 IF '$DATA(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS"))!'(PXRRSESS)
QUIT
+8 FOR C=272.2,272.4,250,401,414,305.1
SET PXRR(C)=0
+9 SET E=0
FOR
SET E=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E))
IF 'E
QUIT
IF $DATA(^TMP($JOB,PXRRCLIN,"ICD",E,C))
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E,C,DFN))
IF 'DFN
QUIT
SET PXRR(C)=$SELECT('$DATA(C(DFN)):PXRR(C)+1,1:PXRR(C))
SET C(DFN)=""
+10 KILL C
SET E=PXRRBDT
FOR
SET E=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E))
IF 'E!(E>PXRREDT)
QUIT
SET C=0
FOR
SET C=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E,C))
IF 'C
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E,C,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+11 IF '$DATA(PXRR(C))
SET PXRR(C)=0
+12 SET PXRR(C)=$SELECT('$DATA(C(C,DFN)):PXRR(C)+1,1:0)
SET C(C,DFN)=""
End DoDot:1
+13 KILL C
SET PXRR(272)=PXRR(272.4)+$GET(PXRR(272.2))
SET PXRR(305)=0
FOR C=305.1:.01:305.13
SET PXRR(305)=PXRR(305)+$GET(PXRR(C))
+14 SET PXRRDM=$GET(PXRR(250))
SET PXRRHTN=$GET(PXRR(401))
SET PXRRCAD=$GET(PXRR(414))
SET PXRRHLIP=PXRR(272)
SET PXRRSMYR=PXRR(305)
+15 ;_._._._._._._._._.Diabetes and Hypertensive Patients_._._._._._._._.
+16 SET PXRRHTDM=0
SET E=PXRRBDT
FOR
SET E=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E))
IF 'E!(E>PXRREDT)
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"ICD",E,250,DFN))
IF 'DFN
QUIT
IF $DATA(^TMP($JOB,PXRRCLIN,"ICD PAT",401,DFN))
Begin DoDot:1
+17 SET X=PXRRBDT
FOR
SET X=$ORDER(^TMP($JOB,PXRRCLIN,"ICD PAT",401,DFN,X))
IF 'X
QUIT
IF X<PXRREDT
SET PXRRHTDM=PXRRHTDM+1
End DoDot:1
+18 ; _._._._._._._._._._._Smokers with CAD DX_._._._._._._._._._._._._.
+19 SET PXRRCDSM=0
SET C=304
FOR
SET C=$ORDER(^TMP($JOB,PXRRCLIN,"ICD PAT",C))
IF 'C!(C>305.13)
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^(C,DFN))
IF 'DFN
QUIT
SET E=PXRRSXMO
FOR
SET E=$ORDER(^(C,DFN,E))
IF 'E
QUIT
IF $DATA(^TMP($JOB,PXRRCLIN,"ICD PAT",414,DFN))
SET PXRRCDSM=PXRRCDSM+1
HBA1 ; _._._._._._._._._._.HTN AND/OR HBA1C w/ DM DX_._._._._._._._._._._._.
+1 ; **Site Specific Entries for Selected Labs**
+2 SET PX=$ORDER(^PX(815,0))
SET C=250
SET (DFN,PXRRHBA1)=0
SET PXRRLED=(9999999.9999999-PXRRSXMO)
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"ICD PAT",C,DFN))
IF 'DFN
QUIT
Begin DoDot:1
+3 SET PXRLRDFN=$PIECE($GET(^DPT(DFN,"LR")),U)
IF 'PXRLRDFN
QUIT
SET L=0
FOR
SET L=$ORDER(^PX(815,PX,"RR5",L))
IF 'L
QUIT
SET X=$PIECE(^(L,0),U)
SET X=$PIECE($PIECE(^LAB(60,X,0),U,5),";",2)
SET E=9999999.9999999-DT
FOR
SET E=$ORDER(^LR(PXRLRDFN,"CH",E))
IF 'E!(E>PXRRLED)
QUIT
Begin DoDot:2
+4 IF +$PIECE($GET(^LR(PXRLRDFN,"CH",E,X)),U)
SET PXRRHBA1=PXRRHBA1+$PIECE($GET(^LR(PXRLRDFN,"CH",E,X)),U)
SET ^TMP($JOB,PXRRCLIN,"HBA1C",DFN,E)=$PIECE($GET(^LR(PXRLRDFN,"CH",E,X)),U)
End DoDot:2
End DoDot:1
+5 SET (PXRRHBG7,PXRRHBPT,DFN)=0
FOR
SET DFN=$ORDER(^TMP($JOB,PXRRCLIN,"HBA1C",DFN))
IF 'DFN
QUIT
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,PXRRCLIN,"HBA1C",DFN,X))
IF 'X
QUIT
SET PXRRHBPT=PXRRHBPT+1
Begin DoDot:1
+6 IF $GET(^TMP($JOB,PXRRCLIN,"HBA1C",DFN,X))>6.99
IF '$DATA(X(DFN))
SET PXRRHBG7=PXRRHBG7+1
+7 SET X(DFN)=""
End DoDot:1
+8 KILL X
IF $GET(PXRRHBA1)>0
SET PXRRHBA1=PXRRHBA1/PXRRHBPT
+9 IF 'PXRRHBPT
SET PXRRHBA1="N/A"
SET PXRRHBG7=0
SXUTTOT ;_._._._._._._._._.Quality Care & Util 7 other Totals_._._._._._._._.
+1 DO ^PXRRPCE4
+2 IF '$DATA(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS"))
SET ^TMP($JOB,PXRRCLIN,"PATIENT","NONE",PXRRCLIN)=""
QT QUIT
AGE ;_._._._._._._._._._.Calculate a patient's age_._._._._._._._._._.
+1 IF $DATA(^TMP($JOB,PXRRCLIN,"CLINIC PATIENTS",DFN))
SET X=0
QUIT
+2 DO DEM^VADPT
IF VADM(4)
SET ^TMP($JOB,PXRRCLIN,"PATIENT AGE",VADM(4),DFN)=Z
DO KVAR^VADPT
+3 QUIT
