BQIMURPT ;GDIT/HS/ALA-On Demand MU CQ Report ; 07 Nov 2011 10:59 AM
;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
;
;
EN(TDATA,PARMS) ;EP -- BQI PROV CQ MEAS REPORT
NEW UID,II,HDR,LIST,BN,BQ,PDATA,NAME,VALUE,BM,MSN,IND,PRV,BP,BGPPROV
NEW BGPBEN,BGPRTYPE,BGP0RPTH,BGPMUT,BGPMUYF,BGPBD,BGPED,PERIOD,BQIGREF
NEW CDATA,CURR,CDEN,CNUM,CEXC,I,PROV,TMFRAME,BEGDT,MLIST,PLIST,DFN,NUM
NEW BGPTP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S TDATA=$NA(^TMP("BQIMURPT",UID))
K @TDATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMURPT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S HDR="T00050PROVIDER^T00030PERIOD^"
K BGPIND,BQIND,PROV
I $G(PARMS)="" D
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
F BQ=1:1:$L(PARMS,$C(28)) D
. S PDATA=$P(PARMS,$C(28),BQ) I PDATA="" Q
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2)
. I NAME="BEGDT" S @NAME=$$DATE^BQIUL1(VALUE) Q
. I NAME="TMFRAME" S @NAME=VALUE Q
. I NAME="MLIST" D Q
.. F BM=1:1:$L(VALUE,$C(29)) S ID=$P(VALUE,$C(29),BM) Q:ID="" D
... S MSN=$O(^BGPMUIND(90596.11,"C",ID,"")) I MSN="" Q
... S IND=$P(^BGPMUIND(90596.11,MSN,0),U,1)
... S BGPIND(IND)="",BQIND(MSN)=""
... S HDR=HDR_"T00005"_ID_"^T00005HIDE_"_ID_"^"
. I NAME="PLIST" D Q
.. F BP=1:1:$L(VALUE,$C(29)) S PRV=$P(VALUE,$C(29),BP) Q:PRV="" S PROV(PRV)=""
S HDR=$$TKO^BQIUL1(HDR,"^")
S @TDATA@(II)=HDR_$C(30)
; For 90 day timeframe
S BGPPROV=""
F S BGPPROV=$O(PROV(BGPPROV)) Q:BGPPROV="" D
. S BGPBEN=3
. S BGPRTYPE=4,BGP0RPTH="A",BGPMUT="P",BGPMUYF=90595.11
. S (BGPBD,BGPED,BGPTP,BGPINDT)=""
. S BGPBD=$$DATE^BQIUL1(BEGDT),BGPED=$$FMADD^XLFDT(BGPBD,90)
. S PERIOD=$$FMTE^BQIUL1(BGPBD)_" - "_$$FMTE^BQIUL1(BGPED)
. ; Previous
. ;S BGPPED=$$FMADD^XLFDT(BGPBD,-1),BGPPBD=$$FMADD^XLFDT(BGPPED,-90)
. S BGPPBD="",BGPPED=""
. ; Baseline
. S BGPBBD=BGPPBD,BGPBED=BGPPED
. S BQIGREF=$NA(^TMP("BQICQM",$J)) K @BQIGREF
. ;
. ; Get measures
. D BQI^BGPMUEPD(.BQIGREF,BGPPROV)
. K CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,NUM
. I '$D(@BQIGREF) D
.. S CDATA=""
.. F BM=3:2:($L(HDR,"^")-1) S CDATA=CDATA_"NDA"_U_"No Data Available"_U
. S DFN=""
. F S DFN=$O(@BQIGREF@(BGPPROV,DFN)) Q:DFN="" D
.. S I=""
.. F S I=$O(@BQIGREF@(BGPPROV,DFN,"C",I)) Q:I="" D
... S CDEN(I)=$G(CDEN(I))+$P($G(@BQIGREF@(BGPPROV,DFN,"C",I)),U,1)
... S NUM=$P($G(@BQIGREF@(BGPPROV,DFN,"C",I)),U,2)
... I NUM>1,$$FMTE^BQIUL1(NUM)'?.N S NUM=1
... S CNUM(I)=$G(CNUM(I))+NUM
... S CEXC(I)=$G(CEXC(I))+$P($G(@BQIGREF@(BGPPROV,DFN,"C",I)),U,3)
... ;S BQIND(I)=""
.. S I="",CDATA=""
.. F S I=$O(BQIND(I)) Q:I="" D
... S MSN=$P(^BGPMUIND(90596.11,I,0),U,1)
... I $G(^BGPMUIND(90595.11,MSN,0))="" Q
... I $P(^BGPMUIND(90595.11,MSN,0),U,4)="H" Q
... I +$G(CNUM(I))=0 S CURR="0%"_U_"Numerator: "_$G(CNUM(I))_" Denominator: "_$G(CDEN(I))
... I +$G(CDEN(I))'=0,+$G(CNUM(I))'=0 S CURR=(CNUM(I)/CDEN(I))*100,CURR=$J(CURR,3,0)_"%",CURR=$$TRIM^BQIUL1(CURR," ")_U_"Numerator: "_$G(CNUM(I))_" Denominator: "_$G(CDEN(I))
... I $G(CDEN(I))="",$G(CNUM(I))="",$G(CEXC(I))'="" S CURR="Excluded"_U_$G(CEXC(I))
... I $G(CDEN(I))="",$G(CNUM(I))="",$G(CEXC(I))="" S CURR="N/A^Not Applicable"
... S CDATA=CDATA_CURR_U
. S CDATA=$$TKO^BQIUL1(CDATA,"^")
. S II=II+1,@TDATA@(II)=BGPPROV_$C(28)_$P(^VA(200,BGPPROV,0),U,1)_U_PERIOD_U_CDATA_$C(30)
;
DONE ;
S II=II+1,@TDATA@(II)=$C(31)
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(TDATA) S II=II+1,@TDATA@(II)=$C(31)
Q
BQIMURPT ;GDIT/HS/ALA-On Demand MU CQ Report ; 07 Nov 2011 10:59 AM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
+2 ;
+3 ;
EN(TDATA,PARMS) ;EP -- BQI PROV CQ MEAS REPORT
+1 NEW UID,II,HDR,LIST,BN,BQ,PDATA,NAME,VALUE,BM,MSN,IND,PRV,BP,BGPPROV
+2 NEW BGPBEN,BGPRTYPE,BGP0RPTH,BGPMUT,BGPMUYF,BGPBD,BGPED,PERIOD,BQIGREF
+3 NEW CDATA,CURR,CDEN,CNUM,CEXC,I,PROV,TMFRAME,BEGDT,MLIST,PLIST,DFN,NUM
+4 NEW BGPTP
+5 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+6 SET TDATA=$NAME(^TMP("BQIMURPT",UID))
+7 KILL @TDATA
+8 SET II=0
+9 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMURPT D UNWIND^%ZTER"
+10 SET HDR="T00050PROVIDER^T00030PERIOD^"
+11 KILL BGPIND,BQIND,PROV
+12 IF $GET(PARMS)=""
Begin DoDot:1
+13 SET LIST=""
SET BN=""
+14 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+15 KILL PARMS
+16 SET PARMS=LIST
+17 KILL LIST
End DoDot:1
+18 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+19 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+20 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2)
+21 IF NAME="BEGDT"
SET @NAME=$$DATE^BQIUL1(VALUE)
QUIT
+22 IF NAME="TMFRAME"
SET @NAME=VALUE
QUIT
+23 IF NAME="MLIST"
Begin DoDot:2
+24 FOR BM=1:1:$LENGTH(VALUE,$CHAR(29))
SET ID=$PIECE(VALUE,$CHAR(29),BM)
IF ID=""
QUIT
Begin DoDot:3
+25 SET MSN=$ORDER(^BGPMUIND(90596.11,"C",ID,""))
IF MSN=""
QUIT
+26 SET IND=$PIECE(^BGPMUIND(90596.11,MSN,0),U,1)
+27 SET BGPIND(IND)=""
SET BQIND(MSN)=""
+28 SET HDR=HDR_"T00005"_ID_"^T00005HIDE_"_ID_"^"
End DoDot:3
End DoDot:2
QUIT
+29 IF NAME="PLIST"
Begin DoDot:2
+30 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET PRV=$PIECE(VALUE,$CHAR(29),BP)
IF PRV=""
QUIT
SET PROV(PRV)=""
End DoDot:2
QUIT
End DoDot:1
+31 SET HDR=$$TKO^BQIUL1(HDR,"^")
+32 SET @TDATA@(II)=HDR_$CHAR(30)
+33 ; For 90 day timeframe
+34 SET BGPPROV=""
+35 FOR
SET BGPPROV=$ORDER(PROV(BGPPROV))
IF BGPPROV=""
QUIT
Begin DoDot:1
+36 SET BGPBEN=3
+37 SET BGPRTYPE=4
SET BGP0RPTH="A"
SET BGPMUT="P"
SET BGPMUYF=90595.11
+38 SET (BGPBD,BGPED,BGPTP,BGPINDT)=""
+39 SET BGPBD=$$DATE^BQIUL1(BEGDT)
SET BGPED=$$FMADD^XLFDT(BGPBD,90)
+40 SET PERIOD=$$FMTE^BQIUL1(BGPBD)_" - "_$$FMTE^BQIUL1(BGPED)
+41 ; Previous
+42 ;S BGPPED=$$FMADD^XLFDT(BGPBD,-1),BGPPBD=$$FMADD^XLFDT(BGPPED,-90)
+43 SET BGPPBD=""
SET BGPPED=""
+44 ; Baseline
+45 SET BGPBBD=BGPPBD
SET BGPBED=BGPPED
+46 SET BQIGREF=$NAME(^TMP("BQICQM",$JOB))
KILL @BQIGREF
+47 ;
+48 ; Get measures
+49 DO BQI^BGPMUEPD(.BQIGREF,BGPPROV)
+50 KILL CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,NUM
+51 IF '$DATA(@BQIGREF)
Begin DoDot:2
+52 SET CDATA=""
+53 FOR BM=3:2:($LENGTH(HDR,"^")-1)
SET CDATA=CDATA_"NDA"_U_"No Data Available"_U
End DoDot:2
+54 SET DFN=""
+55 FOR
SET DFN=$ORDER(@BQIGREF@(BGPPROV,DFN))
IF DFN=""
QUIT
Begin DoDot:2
+56 SET I=""
+57 FOR
SET I=$ORDER(@BQIGREF@(BGPPROV,DFN,"C",I))
IF I=""
QUIT
Begin DoDot:3
+58 SET CDEN(I)=$GET(CDEN(I))+$PIECE($GET(@BQIGREF@(BGPPROV,DFN,"C",I)),U,1)
+59 SET NUM=$PIECE($GET(@BQIGREF@(BGPPROV,DFN,"C",I)),U,2)
+60 IF NUM>1
IF $$FMTE^BQIUL1(NUM)'?.N
SET NUM=1
+61 SET CNUM(I)=$GET(CNUM(I))+NUM
+62 SET CEXC(I)=$GET(CEXC(I))+$PIECE($GET(@BQIGREF@(BGPPROV,DFN,"C",I)),U,3)
+63 ;S BQIND(I)=""
End DoDot:3
+64 SET I=""
SET CDATA=""
+65 FOR
SET I=$ORDER(BQIND(I))
IF I=""
QUIT
Begin DoDot:3
+66 SET MSN=$PIECE(^BGPMUIND(90596.11,I,0),U,1)
+67 IF $GET(^BGPMUIND(90595.11,MSN,0))=""
QUIT
+68 IF $PIECE(^BGPMUIND(90595.11,MSN,0),U,4)="H"
QUIT
+69 IF +$GET(CNUM(I))=0
SET CURR="0%"_U_"Numerator: "_$GET(CNUM(I))_" Denominator: "_$GET(CDEN(I))
+70 IF +$GET(CDEN(I))'=0
IF +$GET(CNUM(I))'=0
SET CURR=(CNUM(I)/CDEN(I))*100
SET CURR=$JUSTIFY(CURR,3,0)_"%"
SET CURR=$$TRIM^BQIUL1(CURR," ")_U_"Numerator: "_$GET(CNUM(I))_" Denominator: "_$GET(CDEN(I))
+71 IF $GET(CDEN(I))=""
IF $GET(CNUM(I))=""
IF $GET(CEXC(I))'=""
SET CURR="Excluded"_U_$GET(CEXC(I))
+72 IF $GET(CDEN(I))=""
IF $GET(CNUM(I))=""
IF $GET(CEXC(I))=""
SET CURR="N/A^Not Applicable"
+73 SET CDATA=CDATA_CURR_U
End DoDot:3
End DoDot:2
+74 SET CDATA=$$TKO^BQIUL1(CDATA,"^")
+75 SET II=II+1
SET @TDATA@(II)=BGPPROV_$CHAR(28)_$PIECE(^VA(200,BGPPROV,0),U,1)_U_PERIOD_U_CDATA_$CHAR(30)
End DoDot:1
+76 ;
DONE ;
+1 SET II=II+1
SET @TDATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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(TDATA)
SET II=II+1
SET @TDATA@(II)=$CHAR(31)
+6 QUIT
