BQIIPCM ;VNGT/HS/ALA-Get IPC Monthly Data by Provider ; 17 Jun 2011 12:38 PM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
;
RET(DATA,PROV,TMFRAME,CRIPC) ;EP -- BQI GET IPC PROV MONTHLY
NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TRM
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("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="Ever" S TMFRAME=""
I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPMRANGE"
. 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("AD",DATE),-1) Q:DATE=""!(QDF) D
. 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)
K Z
Q
;
HH(DATE) ;EP
S BQMON=$E(DATE,4,5)
S TIT=$P($T(MON+BQMON^BQIIPUTL),";;",2)_"_"_(1700+$E(DATE,1,3))
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
.. 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'="P" 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,1,"B",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQIPROV(PRV,30,IDN,1,MSDN,0),U,2),NUM=+$P(^BQIPROV(PRV,30,IDN,1,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 ;
. I '$D(M) S MEDIAN="^"
. I $D(M) D MEDIAN(.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("AD",DATE),-1) Q:DATE=""!(QDF) D
.. 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 MONTHLY
NEW UID,II,HDR,FAC,CYR,DATE,Z,I,IDN,ID,DTI,MSDN,DEN,NUM,VAL,DDATA,TIT,BQMON,DATE
NEW CAT,CRN,GOAL,IDD,MEAS,ORD,QDF,QFL,SAME,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="Ever" S TMFRAME=""
I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPMRANGE"
. 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(FAC,30,"AB",DATE),-1) Q:DATE=""!(QDF) D
. 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" 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,1,"B",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQIFAC(FAC,30,IDN,1,MSDN,0),U,2),NUM=+$P(^BQIFAC(FAC,30,IDN,1,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: 0",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(.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 FAC=$$HME^BQIGPUTL()
. D RSF
S @DATA@(II)=$C(31)
K Z
Q
;
RSF ;EP - Reset dates for facility
S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
F S DATE=$O(^BQIFAC(FAC,30,"AB",DATE),-1) Q:DATE=""!(QDF) D
. 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
;
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 MONTHLY
NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA
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="Ever" S TMFRAME=""
I TMFRAME'="" D
. I TMFRAME?.N S TMFRAME=$P(^BQI(90506.9,TMFRAME,0),"^",1)
. S PPIEN="IPC",TYPE="IPMRANGE"
. 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("AB",DATE),-1) Q:DATE=""!(QDF) D
. 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
. 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)
K Z,M
Q
;
RTM(TMN) ;EP
S DDATA=""
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
. 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
.. 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'="T" 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,10,"B",DTI,""))
... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... ;S DEN=+$P(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,3)
... I ID="IPC_TOTP" D Q
.... I MSDN="" S Z(DTI)="N/A^Not Applicable" Q
... S DEN=+$P(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,10,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,10,"B",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(.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=TEM_U
. S FAC=$$HME^BQIGPUTL()
. S DATE=$S(TMFRAME'="":RTHRU+1,1:""),QDF=0
. F S DATE=$O(^BQITEAM("AB",DATE),-1) Q:DATE=""!(QDF) D
.. 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
;
MEDIAN(MM,MEDIAN) ;EP - Find Median value
NEW N,CT,NN,QQF
S MEDIAN=""
S N="",CT=0,QQF=0
F S N=$O(MM(N)) Q:N="" D Q:QQF
. S NN="" F S NN=$O(MM(N,NN)) Q:NN="" S CT=CT+1
I CT=1 S MEDIAN=$O(MM("")),QQF=1 Q
S OEVN=CT#2,ODD=1
I 'OEVN S ODD=0
;
S N="",T=0
I ODD D Q
. S QFF=0
. F S N=$O(MM(N)) Q:N="" D Q:QFF
.. S NN="" F S NN=$O(MM(N,NN)) Q:NN="" D Q:QFF
... S T=T+1 I T=((CT\2)+1) S MEDIAN=N,QFF=1 Q
;
I 'ODD D
. S T1=(CT\2),T2=T1+1,QFF=0
. F S N=$O(MM(N)) Q:N="" D Q:QFF
.. S NN="" F S NN=$O(MM(N,NN)) Q:NN="" S T=T+1 D Q:QFF
... I T=T1 S V1=N Q
... I T=T2 S V2=N S QFF=1
. S MEDIAN=(V1+V2)/2
Q
BQIIPCM ;VNGT/HS/ALA-Get IPC Monthly Data by Provider ; 17 Jun 2011 12:38 PM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
+3 ;
RET(DATA,PROV,TMFRAME,CRIPC) ;EP -- BQI GET IPC PROV MONTHLY
+1 NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA,TRM
+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("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="Ever"
SET TMFRAME=""
+14 IF TMFRAME'=""
Begin DoDot:1
+15 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+16 SET PPIEN="IPC"
SET TYPE="IPMRANGE"
+17 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+18 ;
+19 KILL Z
+20 SET HDR="T00050PROVIDER^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+21 SET FAC=$$HME^BQIGPUTL()
+22 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+23 FOR
SET DATE=$ORDER(^BQIPROV("AD",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+24 SET Z(DATE)="N/A^Not Applicable"
+25 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+26 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
+27 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+28 SET HDR=HDR_"T00004MEDIAN"
+29 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+30 ;
+31 SET (C1,C2,C3,C4,CT,PCT)=0
+32 SET PROV=$GET(PROV,"")
+33 IF PROV'=""
DO RTE(PROV)
GOTO DONE
+34 IF PROV=""
SET PROV=+PROV
+35 FOR
SET PROV=$ORDER(^BQIPROV(PROV))
IF 'PROV
QUIT
Begin DoDot:1
+36 IF $DATA(^BQIPROV(PROV,30))
DO RTE(PROV)
End DoDot:1
+37 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 KILL Z
+3 QUIT
+4 ;
HH(DATE) ;EP
+1 SET BQMON=$EXTRACT(DATE,4,5)
+2 SET TIT=$PIECE($TEXT(MON+BQMON^BQIIPUTL),";;",2)_"_"_(1700+$EXTRACT(DATE,1,3))
+3 SET HDR=HDR_"T00030"_TIT_U_"T00045HIDE_"_TIT_U
+4 QUIT
+5 ;
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 NEW DA,IENS
+13 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+14 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+15 SET TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
+16 SET STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
+17 IF TAB="A"
IF STAB'="P"
SET QFL=1
QUIT
+18 IF CAT=""
Begin DoDot:3
+19 SET CODE=ID
+20 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+21 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+22 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+23 SET IDN=$ORDER(^BQIPROV(PRV,30,"B",ID,""))
IF IDN=""
QUIT
+24 SET DTI=""
SET MC=0
+25 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+26 SET MSDN=$ORDER(^BQIPROV(PRV,30,IDN,1,"B",DTI,""))
+27 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+28 SET DEN=+$PIECE(^BQIPROV(PRV,30,IDN,1,MSDN,0),U,2)
SET NUM=+$PIECE(^BQIPROV(PRV,30,IDN,1,MSDN,0),U,3)
SET MC=MC+1
+29 IF ID="IPC_TOTP"
Begin DoDot:4
+30 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+31 IF ID="IPC_REVG"
Begin DoDot:4
+32 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+33 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+34 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+35 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+36 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: "_DEN
SET M(0,MC)=""
QUIT
+37 IF NUM'=0
Begin DoDot:4
+38 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+39 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+40 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
End DoDot:3
End DoDot:2
+41 ;
IF QFL
QUIT
+42 IF '$DATA(M)
SET MEDIAN="^"
+43 IF $DATA(M)
DO MEDIAN(.M,.MEDIAN)
+44 SET DTI=""
+45 FOR
SET DTI=$ORDER(Z(DTI),-1)
IF DTI=""
QUIT
SET DDATA=DDATA_Z(DTI)_U
+46 SET DDATA=DDATA_MEDIAN
+47 SET DDATA=$$TKO^BQIUL1(DDATA,"^")
+48 SET II=II+1
SET @DATA@(II)=DDATA_$CHAR(30)
+49 KILL Z,M
+50 SET DDATA=PRVR_U
+51 SET FAC=$$HME^BQIGPUTL()
+52 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+53 FOR
SET DATE=$ORDER(^BQIPROV("AD",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:2
+54 SET Z(DATE)="N/A^Not Applicable"
+55 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+56 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:2
End DoDot:1
+57 QUIT
+58 ;
FAC(DATA,TMFRAME,CRIPC) ;EP -- BQI GET IPC FAC MONTHLY
+1 NEW UID,II,HDR,FAC,CYR,DATE,Z,I,IDN,ID,DTI,MSDN,DEN,NUM,VAL,DDATA,TIT,BQMON,DATE
+2 NEW CAT,CRN,GOAL,IDD,MEAS,ORD,QDF,QFL,SAME,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="Ever"
SET TMFRAME=""
+14 IF TMFRAME'=""
Begin DoDot:1
+15 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+16 SET PPIEN="IPC"
SET TYPE="IPMRANGE"
+17 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+18 ;
+19 KILL Z
+20 SET HDR="T00030FACILITY^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+21 SET FAC=$$HME^BQIGPUTL()
+22 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+23 FOR
SET DATE=$ORDER(^BQIFAC(FAC,30,"AB",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+24 SET Z(DATE)="N/A^Not Applicable"
+25 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+26 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
+27 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+28 SET HDR=HDR_"T00004MEDIAN"
+29 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+30 ;
+31 SET FAC=$$HME^BQIGPUTL()
+32 SET II=II+1
SET SAME=FAC_$CHAR(28)_$PIECE(^DIC(4,FAC,0),U,1)_U
SET DDATA=SAME
+33 ;
+34 SET ORD=""
+35 FOR
SET ORD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD))
IF ORD=""
QUIT
Begin DoDot:1
+36 SET IDD=""
SET QFL=0
+37 FOR
SET IDD=$ORDER(^BQI(90508,1,22,CRN,1,"C",ORD,IDD))
IF IDD=""
QUIT
Begin DoDot:2
+38 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)
+39 IF $PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,7)=1
SET QFL=1
QUIT
+40 SET TAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,13)
+41 SET STAB=$PIECE(^BQI(90508,1,22,CRN,1,IDD,0),U,14)
+42 ;I TAB'="A" S QFL=1 Q
+43 NEW DA,IENS
+44 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+45 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+46 IF CAT=""
Begin DoDot:3
+47 SET CODE=ID
+48 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+49 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+50 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+51 SET IDN=$ORDER(^BQIFAC(FAC,30,"B",ID,""))
IF IDN=""
QUIT
+52 SET DTI=""
SET MC=0
+53 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+54 SET MSDN=$ORDER(^BQIFAC(FAC,30,IDN,1,"B",DTI,""))
+55 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+56 SET DEN=+$PIECE(^BQIFAC(FAC,30,IDN,1,MSDN,0),U,2)
SET NUM=+$PIECE(^BQIFAC(FAC,30,IDN,1,MSDN,0),U,3)
SET MC=MC+1
+57 IF ID="IPC_TOTP"
Begin DoDot:4
+58 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+59 IF ID="IPC_REVG"
Begin DoDot:4
+60 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+61 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+62 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+63 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+64 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+65 IF NUM'=0
Begin DoDot:4
+66 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+67 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+68 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
End DoDot:3
End DoDot:2
+69 ;
IF QFL=1
QUIT
+70 ;S DTI="",TOT=0,TNM=0 F S DTI=$O(Z(DTI)) Q:DTI="" S TOT=TOT+1 S:Z(DTI)="" TNM=TNM+1
+71 ;I TNM=TOT Q
+72 IF '$DATA(M)
SET MEDIAN="^"
+73 IF $DATA(M)
DO MEDIAN(.M,.MEDIAN)
+74 SET DTI=""
+75 FOR
SET DTI=$ORDER(Z(DTI),-1)
IF DTI=""
QUIT
SET DDATA=DDATA_Z(DTI)_U
+76 SET DDATA=DDATA_MEDIAN
+77 SET @DATA@(II)=$$TKO^BQIUL1(DDATA,U)_$CHAR(30)
+78 SET DDATA=SAME
+79 SET II=II+1
+80 KILL Z,M
+81 SET FAC=$$HME^BQIGPUTL()
+82 DO RSF
End DoDot:1
+83 SET @DATA@(II)=$CHAR(31)
+84 KILL Z
+85 QUIT
+86 ;
RSF ;EP - Reset dates for facility
+1 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+2 FOR
SET DATE=$ORDER(^BQIFAC(FAC,30,"AB",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+3 SET Z(DATE)="N/A^Not Applicable"
+4 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+5 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
+6 QUIT
+7 ;
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 MONTHLY
+1 NEW UID,II,HDR,C1,C2,C3,C4,NAME,HEAD,HX,PEC,SORT,QFL,PCT,CT,DDATA
+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="Ever"
SET TMFRAME=""
+14 IF TMFRAME'=""
Begin DoDot:1
+15 IF TMFRAME?.N
SET TMFRAME=$PIECE(^BQI(90506.9,TMFRAME,0),"^",1)
+16 SET PPIEN="IPC"
SET TYPE="IPMRANGE"
+17 DO RANGE^BQIDCAH1(TMFRAME,PPIEN,TYPE)
End DoDot:1
+18 ;
+19 KILL Z
+20 SET HDR="T00050TEAM^T00075IPC_MEAS^T00030CATEGORY^T00005PERCENT_GOAL^"
+21 SET FAC=$$HME^BQIGPUTL()
+22 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+23 FOR
SET DATE=$ORDER(^BQITEAM("AB",DATE),-1)
IF DATE=""!(QDF)
QUIT
Begin DoDot:1
+24 SET Z(DATE)="N/A^Not Applicable"
+25 IF DATE=$GET(RFROM)
SET QDF=1
QUIT
+26 IF DATE<$GET(RFROM)
KILL Z(DATE)
SET QDF=1
QUIT
End DoDot:1
+27 SET DATE=""
FOR
SET DATE=$ORDER(Z(DATE),-1)
IF DATE=""
QUIT
DO HH(DATE)
+28 SET HDR=HDR_"T00004MEDIAN"
+29 SET @DATA@(II)=$$TKO^BQIUL1(HDR,"^")_$CHAR(30)
+30 ;
+31 SET (C1,C2,C3,C4,CT,PCT)=0
+32 SET TEAM=$GET(TEAM,"")
+33 IF TEAM'=""
Begin DoDot:1
+34 SET TEAM=$ORDER(^BQITEAM("B",TEAM,""))
IF TEAM=""
QUIT
+35 DO RTM(TEAM)
End DoDot:1
GOTO DONE
+36 IF TEAM=""
SET TEAM=+TEAM
+37 FOR
SET TEAM=$ORDER(^BQITEAM(TEAM))
IF 'TEAM
QUIT
Begin DoDot:1
+38 IF $DATA(^BQITEAM(TEAM,10))
DO RTM(TEAM)
End DoDot:1
+39 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+40 KILL Z,M
+41 QUIT
+42 ;
RTM(TMN) ;EP
+1 SET DDATA=""
+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
+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 NEW DA,IENS
+12 SET DA(2)=1
SET DA(1)=CRN
SET DA=IDD
SET IENS=$$IENS^DILF(.DA)
+13 SET CAT=$$GET1^DIQ(90508.221,IENS,.03,"E")
+14 SET TAB=$$GET1^DIQ(90508.221,IENS,.13,"I")
+15 SET STAB=$$GET1^DIQ(90508.221,IENS,.14,"I")
+16 IF TAB="A"
IF STAB'="T"
SET QFL=1
QUIT
+17 IF CAT=""
Begin DoDot:3
+18 SET CODE=ID
+19 SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,""))
IF RIEN=""
QUIT
+20 SET CAT=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
End DoDot:3
+21 SET DDATA=DDATA_ID_$CHAR(28)_MEAS_U_CAT_U_GOAL_U
+22 SET IDN=$ORDER(^BQITEAM(TMN,10,"B",ID,""))
IF IDN=""
QUIT
+23 SET DTI=""
SET MC=0
+24 FOR
SET DTI=$ORDER(Z(DTI))
IF DTI=""
QUIT
Begin DoDot:3
+25 SET MSDN=$ORDER(^BQITEAM(TMN,10,IDN,10,"B",DTI,""))
+26 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
+27 ;S DEN=+$P(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,2),NUM=+$P(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,3)
+28 IF ID="IPC_TOTP"
Begin DoDot:4
+29 IF MSDN=""
SET Z(DTI)="N/A^Not Applicable"
QUIT
End DoDot:4
QUIT
+30 SET DEN=+$PIECE(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,2)
SET NUM=+$PIECE(^BQITEAM(TMN,10,IDN,10,MSDN,0),U,3)
SET MC=MC+1
+31 IF ID="IPC_TOTP"
Begin DoDot:4
+32 SET Z(DTI)=DEN_"^Total Patients: "_DEN
End DoDot:4
QUIT
+33 IF ID="IPC_REVG"
Begin DoDot:4
+34 IF DEN=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+35 IF DEN'=0
IF NUM=0
SET Z(DTI)="$0^Visits: 0 Billed: 0"
QUIT
+36 IF DEN'=0
IF NUM'=0
SET Z(DTI)=$$DOL(NUM/DEN)_U_"Visits: "_DEN_" Billed: "_$$DOL(NUM)
QUIT
End DoDot:4
QUIT
+37 IF DEN=0
SET Z(DTI)="0%^Numerator: 0 Denominator: 0"
SET M(0,MC)=""
QUIT
+38 IF DEN'=0
IF NUM=0
SET Z(DTI)="0%^Numerator: 0 Denominator: "_DEN
SET M(0,MC)=""
QUIT
+39 IF NUM'=0
Begin DoDot:4
+40 SET VAL=$JUSTIFY((NUM/DEN)*100,3,0)
SET M($$TRIM^BQIUL1(VAL," "),MC)=""
+41 SET VAL=$$TRIM^BQIUL1(VAL," ")_"%"
+42 SET Z(DTI)=VAL_U_"Numerator: "_NUM_" Denominator: "_DEN
End DoDot:4
+43 SET MSDN=$ORDER(^BQITEAM(TMN,10,IDN,10,"B",DTI,""))
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(.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=TEM_U
+56 SET FAC=$$HME^BQIGPUTL()
+57 SET DATE=$SELECT(TMFRAME'="":RTHRU+1,1:"")
SET QDF=0
+58 FOR
SET DATE=$ORDER(^BQITEAM("AB",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
End DoDot:1
+62 QUIT
+63 ;
MEDIAN(MM,MEDIAN) ;EP - Find Median value
+1 NEW N,CT,NN,QQF
+2 SET MEDIAN=""
+3 SET N=""
SET CT=0
SET QQF=0
+4 FOR
SET N=$ORDER(MM(N))
IF N=""
QUIT
Begin DoDot:1
+5 SET NN=""
FOR
SET NN=$ORDER(MM(N,NN))
IF NN=""
QUIT
SET CT=CT+1
End DoDot:1
IF QQF
QUIT
+6 IF CT=1
SET MEDIAN=$ORDER(MM(""))
SET QQF=1
QUIT
+7 SET OEVN=CT#2
SET ODD=1
+8 IF 'OEVN
SET ODD=0
+9 ;
+10 SET N=""
SET T=0
+11 IF ODD
Begin DoDot:1
+12 SET QFF=0
+13 FOR
SET N=$ORDER(MM(N))
IF N=""
QUIT
Begin DoDot:2
+14 SET NN=""
FOR
SET NN=$ORDER(MM(N,NN))
IF NN=""
QUIT
Begin DoDot:3
+15 SET T=T+1
IF T=((CT\2)+1)
SET MEDIAN=N
SET QFF=1
QUIT
End DoDot:3
IF QFF
QUIT
End DoDot:2
IF QFF
QUIT
End DoDot:1
QUIT
+16 ;
+17 IF 'ODD
Begin DoDot:1
+18 SET T1=(CT\2)
SET T2=T1+1
SET QFF=0
+19 FOR
SET N=$ORDER(MM(N))
IF N=""
QUIT
Begin DoDot:2
+20 SET NN=""
FOR
SET NN=$ORDER(MM(N,NN))
IF NN=""
QUIT
SET T=T+1
Begin DoDot:3
+21 IF T=T1
SET V1=N
QUIT
+22 IF T=T2
SET V2=N
SET QFF=1
End DoDot:3
IF QFF
QUIT
End DoDot:2
IF QFF
QUIT
+23 SET MEDIAN=(V1+V2)/2
End DoDot:1
+24 QUIT
