- 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
