- 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
