BQIIPCW ;GDIT/HCSD/ALA-Get IPC Weekly Data by Provider ; 28 Sep 2017 8:00 AM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;;
;
RET(DATA,PROV,TMFRAME,CRIPC) ;EP -- BQI GET IPC PROV WEEKLY
NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TAB,STAB
NEW CPER,PPER,TIT,BQMON,DATE,TAB,STAB,TNM,FAC,QDF,RFROM,PPIEN,TYPE,RTHRU,TRM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUPROV",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
; Get current IPC
S CRIPC=$G(CRIPC,"")
I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
;
S TMFRAME=$G(TMFRAME,"") I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPWRANGE"
. D RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
;
K Z
S HDR="T00050PROVIDER^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
S FAC=$$HME^BQIGPUTL()
S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
F S DATE=$O(^BQIPROV("AE",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
. S Z(DATE)="N/A^Not Applicable"
. I DATE=$G(RFROM) S QDF=1 Q
. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
S DATE="" F S DATE=$O(Z(DATE),-1) Q:DATE="" D HH(DATE)
S HDR=HDR_"T00004MEDIAN"
S @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$C(30)
;
S (C1,C2,C3,C4,CT,PCT)=0
S PROV=$G(PROV,"")
I PROV'="" D RTE(PROV) G DONE
I PROV="" S PROV=+PROV
F S PROV=$O(^BQIPROV(PROV)) Q:'PROV D
. I $D(^BQIPROV(PROV,30)) D RTE(PROV)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
HH(DATE) ;EP
S TIT=$$FMTMDY^BQIUL1(DATE)
S HDR=HDR_"T00030"_TIT_U_"T00045HIDE_"_TIT_U
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
RTE(PRV) ;EP
S DDATA="",TRM=0
I $P($G(^VA(200,PRV,0)),U,13)'="" S TRM=1
S PRVR=PRV_$C(28)_$S(TRM:"*",1:"")_$P($G(^VA(200,PRV,0)),U,1)
S DDATA=PRVR_U
S CYR=$E(DT,1,3)
S ORD=""
F S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD="" D
. S IDD="",QFL=0
. F S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD="" D
.. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1),MEAS=$P(^(0),U,4),GOAL=$P(^(0),U,12)
.. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 S QFL=1 Q
.. S TAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
.. S STAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
.. I TAB="A",STAB'="P" S QFL=1 Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=IDD,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. S TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
.. S STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
.. I TAB="A",STAB="F" S QFL=1 Q
.. I CAT="" D
... S CODE=ID
... S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
.. S DDATA=DDATA_ID_$C(28)_MEAS_U_CAT_U_GOAL_U
.. S IDN=$O(^BQIPROV(PRV,30,"B",ID,"")) I IDN="" Q
.. S DTI="",MC=0
.. F S DTI=$O(Z(DTI)) Q:DTI="" D
... S MSDN=$O(^BQIPROV(PRV,30,IDN,2,"AC",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQIPROV(PRV,30,IDN,2,MSDN,0),U,2),NUM=+$P(^BQIPROV(PRV,30,IDN,2,MSDN,0),U,3),MC=MC+1
... I ID="IPC_TOTP" D Q
.... S Z(DTI)=DEN_"^Total Patients: "_DEN
... I ID="IPC_REVG" D Q
.... I DEN=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM'=0 S Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM) Q
... I DEN=0 S Z(DTI)="0%^Numerator: 0 Denominator: 0",M(0,MC)="" Q
... I DEN'=0,NUM=0 S Z(DTI)="0%^Numerator: 0 Denominator: "_DEN,M(0,MC)="" Q
... I NUM'=0 D
.... S VAL=$J((NUM/DEN)*100,3,0),M($$TRIM^BQIUL1(VAL," "),MC)=""
.... S VAL=$$TRIM^BQIUL1(VAL," ")_"%"
.... S Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
. I QFL Q ;
. ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
. ;I TNM=TOT Q
. I '$D(M) S MEDIAN="^"
. I $D(M) D MEDIAN^BQIIPCM(.M,.MEDIAN)
. S DTI=""
. F S DTI=$O(Z(DTI),-1) Q:DTI="" S DDATA=DDATA_Z(DTI)_U
. S DDATA=DDATA_MEDIAN
. S DDATA=$$TKO^BQIUL1(DDATA,"^")
. S II=II+1,@DATA@(II)=DDATA_$C(30)
. K Z,M
. S DDATA=PRVR_U
. S FAC=$$HME^BQIGPUTL()
. S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
. F S DATE=$O(^BQIPROV("AE",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
.. S Z(DATE)="N/A^Not Applicable"
.. I DATE=$G(RFROM) S QDF=1 Q
.. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
Q
;
FAC(DATA,TMFRAME,CRIPC) ;EP -- BQI GET IPC FAC WEEKLY
NEW UID,II,HDR,FAC,CYR,DATE,Z,I,IDN,ID,DTI,MSDN,DEN,NUM,VAL,DDATA,TIT,BQMON,DATE
NEW TAB,STAB
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIPCF",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
; Get current IPC
S CRIPC=$G(CRIPC,"")
I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
;
S TMFRAME=$G(TMFRAME,"") I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPWRANGE"
. D RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
;
K Z
S HDR="T00030FACILITY^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
S FAC=$$HME^BQIGPUTL()
S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
F S DATE=$O(^BQIFAC("AD",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
. S Z(DATE)="N/A^Not Applicable"
. I DATE=$G(RFROM) S QDF=1 Q
. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
S DATE="" F S DATE=$O(Z(DATE),-1) Q:DATE="" D HH(DATE)
S HDR=HDR_"T00004MEDIAN"
S @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$C(30)
;
S FAC=$$HME^BQIGPUTL()
S II=II+1,SAME=FAC_$C(28)_$P(^DIC(4,FAC,0),U,1)_U,DDATA=SAME
;
S ORD=""
F S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD="" D
. S IDD="",QFL=0
. F S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD="" D
.. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1),MEAS=$P(^(0),U,4),GOAL=$P(^(0),U,12)
.. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 S QFL=1 Q
.. S TAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
.. S STAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
.. ;I TAB="A",STAB'="F" S QFL=1 Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=IDD,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. I CAT="" D
... S CODE=ID
... S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
.. S DDATA=DDATA_ID_$C(28)_MEAS_U_CAT_U_GOAL_U
.. S IDN=$O(^BQIFAC(FAC,30,"B",ID,"")) I IDN="" Q
.. S DTI="",MC=0
.. F S DTI=$O(Z(DTI)) Q:DTI="" D
... S MSDN=$O(^BQIFAC(FAC,30,IDN,2,"AC",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQIFAC(FAC,30,IDN,2,MSDN,0),U,2),NUM=+$P(^BQIFAC(FAC,30,IDN,2,MSDN,0),U,3),MC=MC+1
... I ID="IPC_TOTP" D Q
.... S Z(DTI)=DEN_"^Total Patients: "_DEN
... I ID="IPC_REVG" D Q
.... I DEN=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM'=0 S Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM) Q
... I DEN=0 S Z(DTI)="0%^Numerator: 0 Denominator: 0",M(0,MC)="" Q
... I DEN'=0,NUM=0 S Z(DTI)="0%^Numerator: 0 Denominator: "_DEN,M(0,MC)="" Q
... I NUM'=0 D
.... S VAL=$J((NUM/DEN)*100,3,0),M($$TRIM^BQIUL1(VAL," "),MC)=""
.... S VAL=$$TRIM^BQIUL1(VAL," ")_"%"
.... S Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
. I QFL=1 Q ;
. ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
. ;I TNM=TOT Q
. I '$D(M) S MEDIAN="^"
. I $D(M) D MEDIAN^BQIIPCM(.M,.MEDIAN)
. S DTI=""
. F S DTI=$O(Z(DTI),-1) Q:DTI="" S DDATA=DDATA_Z(DTI)_U
. S DDATA=DDATA_MEDIAN
. S @DATA@(II)=$$TKO^BQIUL1(DDATA,U)_$C(30)
. S DDATA=SAME
. S II=II+1
. K Z,M
. S DATE="",FAC=$$HME^BQIGPUTL()
. S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
. F S DATE=$O(^BQIFAC(FAC,30,"AC",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
.. S Z(DATE)="N/A^Not Applicable"
.. I DATE=$G(RFROM) S QDF=1 Q
.. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
S @DATA@(II)=$C(31)
Q
;
DOL(X) ;EP - Dollar formatter
S X2="2$" D COMMA^%DTC S X=X_$E("00",1,2-$L($P(X,".",2))) K X2
Q $$TKO^BQIUL1($$TRIM^BQIUL1(X," ")," ")
;
TEAM(DATA,TEAM,TMFRAME,CRIPC) ;EP - BQI GET IPC TEAM WEEKLY
NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TAB,STAB
NEW CPER,PPER,TIT,BQMON,DATE,TAB,STAB,TNM,FAC,QDF,RFROM,PPIEN,TYPE,RTHRU
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIITEAM",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
; Get current IPC
S CRIPC=$G(CRIPC,"")
I CRIPC="" S CRIPC=$P($G(^BQI(90508,1,11)),U,1)
S CRN=$O(^BQI(90508,1,22,"B",CRIPC,"")) I CRN="" Q
;
S TMFRAME=$G(TMFRAME,"") I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPWRANGE"
. D RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
;
K Z
S HDR="T00050TEAM^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
S FAC=$$HME^BQIGPUTL()
S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
F S DATE=$O(^BQITEAM("AC",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
. S Z(DATE)="N/A^Not Applicable"
. I DATE=$G(RFROM) S QDF=1 Q
. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
S DATE="" F S DATE=$O(Z(DATE),-1) Q:DATE="" D HH(DATE)
S HDR=HDR_"T00004MEDIAN"
S @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$C(30)
;
S (C1,C2,C3,C4,CT,PCT)=0
S TEAM=$G(TEAM,"")
I TEAM'="" D G DONE
. I TEAM'?.N S TEAM=$O(^BQITEAM("B",TEAM,"")) I TEAM="" Q
. D RTM(TEAM)
I TEAM="" S TEAM=+TEAM
F S TEAM=$O(^BQITEAM(TEAM)) Q:'TEAM D
. I $D(^BQITEAM(TEAM,10)) D RTM(TEAM)
S II=II+1,@DATA@(II)=$C(31)
Q
;
RTM(TMN) ;EP
S DDATA="",MEDIAN=""
S TEM=TMN_$C(28)_$P($G(^BQITEAM(TMN,0)),U,1)
S DDATA=TEM_U
S CYR=$E(DT,1,3)
S ORD=""
F S ORD=$O(^BQI(90508,1,22,CRN,1,"C",ORD)) Q:ORD="" D
. S IDD="",QFL=0 K M
. F S IDD=$O(^BQI(90508,1,22,CRN,1,"C",ORD,IDD)) Q:IDD="" D
.. S ID=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,1),MEAS=$P(^(0),U,4),GOAL=$P(^(0),U,12)
.. I $P(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1 S QFL=1 Q
.. S TAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
.. S STAB=$P(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
.. I TAB="A",STAB'="T" S QFL=1 Q
.. NEW DA,IENS
.. S DA(2)=1,DA(1)=CRN,DA=IDD,IENS=$$IENS^DILF(.DA)
.. S CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
.. S TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
.. S STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
.. I TAB="A",STAB="F" S QFL=1 Q
.. I CAT="" D
... S CODE=ID
... S RIEN=$O(^BQI(90506.1,"B",CODE,"")) I RIEN="" Q
... S CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
.. S DDATA=DDATA_ID_$C(28)_MEAS_U_CAT_U_GOAL_U
.. S IDN=$O(^BQITEAM(TMN,10,"B",ID,"")) I IDN="" Q
.. S DTI="",MC=0
.. F S DTI=$O(Z(DTI)) Q:DTI="" D
... S MSDN=$O(^BQITEAM(TMN,10,IDN,20,"AC",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... ;S DEN=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,3),MC=MC+1
... I ID="IPC_TOTP" D Q
.... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,3),MC=MC+1
... I ID="IPC_TOTP" D Q
.... S Z(DTI)=DEN_"^Total Patients: "_DEN
... I ID="IPC_REVG" D Q
.... I DEN=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM=0 S Z(DTI)="$0^Visits: 0 Billed: 0" Q
.... I DEN'=0,NUM'=0 S Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM) Q
... I DEN=0 S Z(DTI)="0%^Numerator: 0 Denominator: 0",M(0,MC)="" Q
... I DEN'=0,NUM=0 S Z(DTI)="0%^Numerator: 0 Denominator: "_DEN,M(0,MC)="" Q
... I NUM'=0 D
.... S VAL=$J((NUM/DEN)*100,3,0),M($$TRIM^BQIUL1(VAL," "),MC)=""
.... S VAL=$$TRIM^BQIUL1(VAL," ")_"%"
.... S Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
... S MSDN=$O(^BQITEAM(TMN,10,IDN,20,"AC",DTI,""))
. I QFL Q ;
. ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
. ;I TNM=TOT Q
. I '$D(M) S MEDIAN="^"
. I $D(M) D MEDIAN^BQIIPCM(.M,.MEDIAN)
. S DTI=""
. F S DTI=$O(Z(DTI),-1) Q:DTI="" S DDATA=DDATA_Z(DTI)_U
. S DDATA=DDATA_MEDIAN
. S DDATA=$$TKO^BQIUL1(DDATA,"^")
. S II=II+1,@DATA@(II)=DDATA_$C(30)
. K Z
. S DDATA=TEM_U
. S FAC=$$HME^BQIGPUTL()
. S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
. F S DATE=$O(^BQITEAM("AC",DATE),-1) Q:DATE=""!(QDF) D Q:QDF
.. S Z(DATE)="N/A^Not Applicable"
.. I DATE=$G(RFROM) S QDF=1 Q
.. I DATE<$G(RFROM) K Z(DATE) S QDF=1 Q
Q
BQIIPCW ;GDIT/HCSD/ALA-Get IPC Weekly Data by Provider ; 28 Sep 2017 8:00 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;;
+3 ;
RET(DATA,PROV,TMFRAME,CRIPC) ;EP -- BQI GET IPC PROV WEEKLY
+1 NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TAB,STAB
+2 NEW CPER,PPER,TIT,BQMON,DATE,TAB,STAB,TNM,FAC,QDF,RFROM,PPIEN,TYPE,RTHRU,TRM
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIMUPROV",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER"
+8 ; Get current IPC
+9 SET CRIPC=$GET(CRIPC,"")
+10 IF CRIPC=""
SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+11 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+12 ;
+13 SET TMFRAME=$GET(TMFRAME,"")
IF TMFRAME'=""
Begin DoDot:1
+14 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+15 SET PPIEN="IPC"
SET TYPE="IPWRANGE"
+16 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+17 ;
+18 KILL Z
+19 SET HDR="T00050PROVIDER^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+20 SET FAC=$$HME^BQIGPUTL()
+21 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+22 FOR
SET DATE=$ORDER(^BQIPROV("AE",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+23 SET Z(DATE)="N/A^Not Applicable"
+24 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+25 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
IF QDF
QUIT
+26 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+27 SET HDR=HDR_"T00004MEDIAN"
+28 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+29 ;
+30 SET (C1,C2,C3,C4,CT,PCT)=0
+31 SET PROV=$GET(PROV,"")
+32 IF PROV'=""
DO RTE(PROV)
GOTO DONE
+33 IF PROV=""
SET PROV=+PROV
+34 FOR
SET PROV=$ORDER(^BQIPROV(PROV))
IF 'PROV
QUIT
Begin DoDot:1
+35 IF $DATA(^BQIPROV(PROV,30))
DO RTE(PROV)
End DoDot:1
+36 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
HH(DATE) ;EP
+1 SET TIT=$$FMTMDY^BQIUL1(DATE)
+2 SET HDR=HDR_"T00030"_TIT_U_"T00045HIDE_"_TIT_U
+3 QUIT
+4 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
RTE(PRV) ;EP
+1 SET DDATA=""
SET TRM=0
+2 IF $PIECE($GET(^VA(200,PRV,0)),U,13)'=""
SET TRM=1
+3 SET PRVR=PRV_$CHAR(28)_$SELECT(TRM:"*",1:"")_$PIECE($GET(^VA(200,PRV,0)),U,1)
+4 SET DDATA=PRVR_U
+5 SET CYR=$EXTRACT(DT,1,3)
+6 SET ORD=""
+7 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+8 SET IDD=""
SET QFL=0
+9 FOR
SET IDD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,IDD))
IF IDD=""
QUIT
Begin DoDot:2
+10 SET ID=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,1)
SET MEAS=$PIECE(^(0),U,4)
SET GOAL=$PIECE(^(0),U,12)
+11 IF $PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1
SET QFL=1
QUIT
+12 SET TAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
+13 SET STAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
+14 IF TAB="A"
IF STAB'="P"
SET QFL=1
QUIT
+15 NEW DA,IENS
+16 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+17 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+18 SET TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
+19 SET STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
+20 IF TAB="A"
IF STAB="F"
SET QFL=1
QUIT
+21 IF CAT=""
Begin DoDot:3
+22 SET CODE=ID
+23 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+24 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+25 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+26 SET IDN=$ORDER(^BQIPROV(PRV,30,"B",ID,""))
IF IDN=""
QUIT
+27 SET DTI=""
SET MC=0
+28 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+29 SET MSDN=$ORDER(^BQIPROV(PRV,30,IDN,2,"AC",DTI,""))
+30 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+31 SET DEN=+$PIECE(^BQIPROV(PRV,30,IDN,2,MSDN,0),U,2)
SET NUM=+$PIECE(^BQIPROV(PRV,30,IDN,2,MSDN,0),U,3)
SET MC=MC+1
+32 IF ID="IPC_TOTP"
Begin DoDot:4
+33 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+34 IF ID="IPC_REVG"
Begin DoDot:4
+35 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+36 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+37 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+38 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+39 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: "_DEN
SET M(0,MC)=""
QUIT
+40 IF NUM'=0
Begin DoDot:4
+41 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+42 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+43 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
End DoDot:3
End DoDot:2
+44 ;
IF QFL
QUIT
+45 ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
+46 ;I TNM=TOT Q
+47 IF '$DATA(M)
SET MEDIAN="^"
+48 IF $DATA(M)
DO MEDIAN^BQIIPCM(.M,.MEDIAN)
+49 SET DTI=""
+50 FOR
SET DTI=$ORDER(Z(DTI),-1)
IF DTI=""
QUIT
SET DDATA=DDATA_Z(DTI)_U
+51 SET DDATA=DDATA_MEDIAN
+52 SET DDATA=$$TKO^BQIUL1(DDATA,"^")
+53 SET II=II+1
SET @DATA@(II)=DDATA_$CHAR(30)
+54 KILL Z,M
+55 SET DDATA=PRVR_U
+56 SET FAC=$$HME^BQIGPUTL()
+57 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+58 FOR
SET DATE=$ORDER(^BQIPROV("AE",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:2
+59 SET Z(DATE)="N/A^Not Applicable"
+60 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+61 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:2
IF QDF
QUIT
End DoDot:1
+62 QUIT
+63 ;
FAC(DATA,TMFRAME,CRIPC) ;EP -- BQI GET IPC FAC WEEKLY
+1 NEW UID,II,HDR,FAC,CYR,DATE,Z,I,IDN,ID,DTI,MSDN,DEN,NUM,VAL,DDATA,TIT,BQMON,DATE
+2 NEW TAB,STAB
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIIPCF",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER"
+8 ; Get current IPC
+9 SET CRIPC=$GET(CRIPC,"")
+10 IF CRIPC=""
SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+11 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+12 ;
+13 SET TMFRAME=$GET(TMFRAME,"")
IF TMFRAME'=""
Begin DoDot:1
+14 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+15 SET PPIEN="IPC"
SET TYPE="IPWRANGE"
+16 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+17 ;
+18 KILL Z
+19 SET HDR="T00030FACILITY^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+20 SET FAC=$$HME^BQIGPUTL()
+21 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+22 FOR
SET DATE=$ORDER(^BQIFAC("AD",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+23 SET Z(DATE)="N/A^Not Applicable"
+24 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+25 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
IF QDF
QUIT
+26 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+27 SET HDR=HDR_"T00004MEDIAN"
+28 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+29 ;
+30 SET FAC=$$HME^BQIGPUTL()
+31 SET II=II+1
SET SAME=FAC_$CHAR(28)_$PIECE(^DIC(4,FAC,0),U,1)_U
SET DDATA=SAME
+32 ;
+33 SET ORD=""
+34 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+35 SET IDD=""
SET QFL=0
+36 FOR
SET IDD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,IDD))
IF IDD=""
QUIT
Begin DoDot:2
+37 SET ID=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,1)
SET MEAS=$PIECE(^(0),U,4)
SET GOAL=$PIECE(^(0),U,12)
+38 IF $PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1
SET QFL=1
QUIT
+39 SET TAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
+40 SET STAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
+41 ;I TAB="A",STAB'="F" S QFL=1 Q
+42 NEW DA,IENS
+43 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+44 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+45 IF CAT=""
Begin DoDot:3
+46 SET CODE=ID
+47 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+48 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+49 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+50 SET IDN=$ORDER(^BQIFAC(FAC,30,"B",ID,""))
IF IDN=""
QUIT
+51 SET DTI=""
SET MC=0
+52 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+53 SET MSDN=$ORDER(^BQIFAC(FAC,30,IDN,2,"AC",DTI,""))
+54 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+55 SET DEN=+$PIECE(^BQIFAC(FAC,30,IDN,2,MSDN,0),U,2)
SET NUM=+$PIECE(^BQIFAC(FAC,30,IDN,2,MSDN,0),U,3)
SET MC=MC+1
+56 IF ID="IPC_TOTP"
Begin DoDot:4
+57 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+58 IF ID="IPC_REVG"
Begin DoDot:4
+59 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+60 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+61 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+62 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+63 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: "_DEN
SET M(0,MC)=""
QUIT
+64 IF NUM'=0
Begin DoDot:4
+65 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+66 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+67 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
End DoDot:3
End DoDot:2
+68 ;
IF QFL=1
QUIT
+69 ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
+70 ;I TNM=TOT Q
+71 IF '$DATA(M)
SET MEDIAN="^"
+72 IF $DATA(M)
DO MEDIAN^BQIIPCM(.M,.MEDIAN)
+73 SET DTI=""
+74 FOR
SET DTI=$ORDER(Z(DTI),-1)
IF DTI=""
QUIT
SET DDATA=DDATA_Z(DTI)_U
+75 SET DDATA=DDATA_MEDIAN
+76 SET @DATA@(II)=$$TKO^BQIUL1(DDATA,U)_$CHAR(30)
+77 SET DDATA=SAME
+78 SET II=II+1
+79 KILL Z,M
+80 SET DATE=""
SET FAC=$$HME^BQIGPUTL()
+81 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+82 FOR
SET DATE=$ORDER(^BQIFAC(FAC,30,"AC",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:2
+83 SET Z(DATE)="N/A^Not Applicable"
+84 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+85 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:2
IF QDF
QUIT
End DoDot:1
+86 SET @DATA@(II)=$CHAR(31)
+87 QUIT
+88 ;
DOL(X) ;EP - Dollar formatter
+1 SET X2="2$"
DO COMMA^%DTC
SET X=X_$EXTRACT("00",1,2-$LENGTH($PIECE(X,".",2)))
KILL X2
+2 QUIT $$TKO^BQIUL1($$TRIM^BQIUL1(X," ")," ")
+3 ;
TEAM(DATA,TEAM,TMFRAME,CRIPC) ;EP - BQI GET IPC TEAM WEEKLY
+1 NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TAB,STAB
+2 NEW CPER,PPER,TIT,BQMON,DATE,TAB,STAB,TNM,FAC,QDF,RFROM,PPIEN,TYPE,RTHRU
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIITEAM",UID))
+5 KILL @DATA
+6 SET II=0
+7 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIIPCM D UNWIND^%ZTER"
+8 ; Get current IPC
+9 SET CRIPC=$GET(CRIPC,"")
+10 IF CRIPC=""
SET CRIPC=$PIECE($GET(^BQI(90508,1,11)),U,1)
+11 SET CRN=$ORDER(^BQI(90508,1,22,"B",CRIPC,""))
IF CRN=""
QUIT
+12 ;
+13 SET TMFRAME=$GET(TMFRAME,"")
IF TMFRAME'=""
Begin DoDot:1
+14 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+15 SET PPIEN="IPC"
SET TYPE="IPWRANGE"
+16 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+17 ;
+18 KILL Z
+19 SET HDR="T00050TEAM^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+20 SET FAC=$$HME^BQIGPUTL()
+21 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+22 FOR
SET DATE=$ORDER(^BQITEAM("AC",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+23 SET Z(DATE)="N/A^Not Applicable"
+24 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+25 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
IF QDF
QUIT
+26 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+27 SET HDR=HDR_"T00004MEDIAN"
+28 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+29 ;
+30 SET (C1,C2,C3,C4,CT,PCT)=0
+31 SET TEAM=$GET(TEAM,"")
+32 IF TEAM'=""
Begin DoDot:1
+33 IF TEAM'?.N
SET TEAM=$ORDER(^BQITEAM("B",TEAM,""))
IF TEAM=""
QUIT
+34 DO RTM(TEAM)
End DoDot:1
GOTO DONE
+35 IF TEAM=""
SET TEAM=+TEAM
+36 FOR
SET TEAM=$ORDER(^BQITEAM(TEAM))
IF 'TEAM
QUIT
Begin DoDot:1
+37 IF $DATA(^BQITEAM(TEAM,10))
DO RTM(TEAM)
End DoDot:1
+38 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+39 QUIT
+40 ;
RTM(TMN) ;EP
+1 SET DDATA=""
SET MEDIAN=""
+2 SET TEM=TMN_$CHAR(28)_$PIECE($GET(^BQITEAM(TMN,0)),U,1)
+3 SET DDATA=TEM_U
+4 SET CYR=$EXTRACT(DT,1,3)
+5 SET ORD=""
+6 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+7 SET IDD=""
SET QFL=0
KILL M
+8 FOR
SET IDD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,IDD))
IF IDD=""
QUIT
Begin DoDot:2
+9 SET ID=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,1)
SET MEAS=$PIECE(^(0),U,4)
SET GOAL=$PIECE(^(0),U,12)
+10 IF $PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1
SET QFL=1
QUIT
+11 SET TAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
+12 SET STAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
+13 IF TAB="A"
IF STAB'="T"
SET QFL=1
QUIT
+14 NEW DA,IENS
+15 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+16 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+17 SET TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
+18 SET STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
+19 IF TAB="A"
IF STAB="F"
SET QFL=1
QUIT
+20 IF CAT=""
Begin DoDot:3
+21 SET CODE=ID
+22 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+23 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+24 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+25 SET IDN=$ORDER(^BQITEAM(TMN,10,"B",ID,""))
IF IDN=""
QUIT
+26 SET DTI=""
SET MC=0
+27 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+28 SET MSDN=$ORDER(^BQITEAM(TMN,10,IDN,20,"AC",DTI,""))
+29 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+30 ;S DEN=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,3),MC=MC+1
+31 IF ID="IPC_TOTP"
Begin DoDot:4
+32 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
End DoDot:4
QUIT
+33 SET DEN=+$PIECE(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,2)
SET NUM=+$PIECE(^BQITEAM(TMN,10,IDN,20,MSDN,0),U,3)
SET MC=MC+1
+34 IF ID="IPC_TOTP"
Begin DoDot:4
+35 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+36 IF ID="IPC_REVG"
Begin DoDot:4
+37 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+38 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+39 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+40 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+41 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: "_DEN
SET M(0,MC)=""
QUIT
+42 IF NUM'=0
Begin DoDot:4
+43 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+44 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+45 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
+46 SET MSDN=$ORDER(^BQITEAM(TMN,10,IDN,20,"AC",DTI,""))
End DoDot:3
End DoDot:2
+47 ;
IF QFL
QUIT
+48 ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
+49 ;I TNM=TOT Q
+50 IF '$DATA(M)
SET MEDIAN="^"
+51 IF $DATA(M)
DO MEDIAN^BQIIPCM(.M,.MEDIAN)
+52 SET DTI=""
+53 FOR
SET DTI=$ORDER(Z(DTI),-1)
IF DTI=""
QUIT
SET DDATA=DDATA_Z(DTI)_U
+54 SET DDATA=DDATA_MEDIAN
+55 SET DDATA=$$TKO^BQIUL1(DDATA,"^")
+56 SET II=II+1
SET @DATA@(II)=DDATA_$CHAR(30)
+57 KILL Z
+58 SET DDATA=TEM_U
+59 SET FAC=$$HME^BQIGPUTL()
+60 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+61 FOR
SET DATE=$ORDER(^BQITEAM("AC",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:2
+62 SET Z(DATE)="N/A^Not Applicable"
+63 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+64 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:2
IF QDF
QUIT
End DoDot:1
+65 QUIT
