BQIIPCW.m

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,""))