BQIMUTAB ;VNGT/HS/ALA-MU Tables ; 25 Feb 2011 1:09 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
;
;
ITM(DATA,TYPE,REPORT) ; EP -- BQI GET MU MEASURES
; Input Parameters
; TYPE = E for Provider, H for Hospital, null for both
NEW UID,II,MN,MDATA,TIP,TP,PGLOB,HDR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUITM",UID))
K @DATA
S II=0,TYPE=$G(TYPE,""),REPORT=$G(REPORT,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030ID^T00001TYPE^T00050NAME^T00001MEASTYPE^T00001SET^T01024TOOLTIP"
S @DATA@(II)=HDR_$C(30)
;S PGLOB=$$CURPGL()
S PGLOB=$$PRFPGL^BQIMUTAB(REPORT)
S MN=0
F S MN=$O(@PGLOB@(MN)) Q:'MN D
. I TYPE'="",$P(@PGLOB@(MN,0),U,2)'=TYPE Q
. S MDATA=@PGLOB@(MN,0)
. ; Ignore attestation measures
. I $P(MDATA,U,6)="A" Q
. S TIP="",TP=0
. F S TP=$O(@PGLOB@(MN,23,TP)) Q:'TP S TIP=TIP_@PGLOB@(MN,23,TP,0)_$C(10)
. S TP=0,TIP=TIP_"TARGET: "_$C(10)
. F S TP=$O(@PGLOB@(MN,13,TP)) Q:'TP S TIP=TIP_@PGLOB@(MN,13,TP,0)_$C(10)
. S II=II+1,@DATA@(II)=$P(MDATA,U,1)_U_$P(MDATA,U,2)_U_$P(MDATA,U,5)_U_$P(MDATA,U,6)_U_$P(MDATA,U,3)_U_TIP_$C(30)
;
DONE ;
S II=II+1,@DATA@(II)=$C(31)
Q
;
MURP(DATA,TYPE) ; EP -- BQI MU PERF REPORT
NEW UID,II,MN,REP
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMURPT",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030REPORT"
S @DATA@(II)=HDR_$C(30)
I '$$PATCH^XPDUTL("APCM*1.0*2") G DONE
S MN=0
F S MN=$O(^APCMMUCN(MN)) Q:'MN D
. I TYPE="SITE" S II=II+1,@DATA@(II)=$P(^APCMMUCN(MN,0),U,1)_$C(30) Q
. S REP=$P(^APCMMUCN(MN,0),U,1)
. ;I '$D(^BQIPROV("AC",REP)) Q
. S II=II+1,@DATA@(II)=REP_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
GCUR(DATA,FAKE) ; EP -- BQI GET MU CURRENT PERF
NEW UID,II,MN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUCUR",UID))
K @DATA
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030REPORT"
S @DATA@(II)=HDR_$C(30)
I '$$PATCH^XPDUTL("APCM*1.0*2") G DONE
S II=II+1,@DATA@(II)=$P($G(^BQI(90508,1,9)),U,3)_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
UCUR(DATA,REP) ; EP -- BQI SET MU CURRENT PERF
NEW UID,II,ERROR
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUCUP",UID))
K @DATA
S II=0,REP=$G(REP,"")
S @DATA@(II)="I00010RESULT^T00030MSG"_$C(30)
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S BQIUPD(90508,"1,",9.03)=REP
S RESULT=1,MSG=""
D FILE^DIE("","BQIUPD","ERROR")
I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
S II=II+1,@DATA@(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(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
MUDT(DATA,MUTYP) ;EP -- BQI GET MU DATES
NEW UID,II
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUDT",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00010ID^T00030"
S @DATA@(II)=HDR_$C(30)
S II=II+1,@DATA@(II)="30^1 Month"_$C(30)
S II=II+1,@DATA@(II)="90^90 Days"_$C(30)
S II=II+1,@DATA@(II)="12^1 Year"_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CQM(DATA,TYPE) ; EP -- BQI GET MU CQ MEASURES
; Input Parameters
; TYPE = E for Provider, H for Hospital, null for both
NEW UID,II,MN,MDATA,TIP,TP,MTYPE,MSN,QFL,BQIDATA
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIMUCQM",UID))
K @DATA
S II=0,TYPE=$G(TYPE,"")
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S HDR="T00030ID^T00001TYPE^T00050NAME^T01024TOOLTIP"
S @DATA@(II)=HDR_$C(30)
;
S MN=0
F S MN=$O(^BGPMUIND(90596.11,MN)) Q:'MN D
. I TYPE'="" S QFL=0 D Q:QFL
.. S MSN=$P(^BGPMUIND(90596.11,MN,0),U,1)
.. I $G(^BGPMUIND(90595.11,MSN,0))="" Q
.. I TYPE="E",$P(^BGPMUIND(90595.11,MSN,0),U,4)="H" S QFL=1 Q
.. I TYPE="H",$P(^BGPMUIND(90595.11,MSN,0),U,4)'="H" S QFL=1 Q
. ;
. S MDATA=^BGPMUIND(90596.11,MN,0)
. S MSN=$P(^BGPMUIND(90596.11,MN,0),U,1)
. I $G(^BGPMUIND(90595.11,MSN,0))="" Q
. S MTYPE=$$GET1^DIQ(90595.11,MSN_",",.04,"E")
. S BQIDATA=$G(^BGPMUIND(90596.11,MN,17)) I BQIDATA="" Q
. S TIP=$G(^BGPMUIND(90595.11,MSN,18,1,0))_$C(10),TP=0
. F S TP=$O(^BGPMUIND(90596.11,MN,18,TP)) Q:'TP S TIP=TIP_^BGPMUIND(90596.11,MN,18,TP,0)_$C(10)
. S II=II+1,@DATA@(II)=$P(MDATA,U,4)_U_MTYPE_U_$P(BQIDATA,U,3)_U_TIP_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CURPGL() ;EP - Get current performance report global
NEW CURR,PCN,PGB,PGLOB
S PGLOB="^APCMMUM"
S CURR=$P($G(^BQI(90508,1,9)),U,3)
I CURR'="" D
. S PCN=$O(^APCMMUCN("B",CURR,"")) I PCN="" Q
. S PGB=$P(^APCMMUCN(PCN,0),U,4)
. S PGLOB=$$ROOT^DILFD(PGB,"",1)
Q PGLOB
;
CURPRT() ;EP - Get current performance report routine
NEW PROU,CURR,PCN
S PROU="APCM11E1"
S CURR=$P($G(^BQI(90508,1,9)),U,3)
I CURR'="" D
. S PCN=$O(^APCMMUCN("B",CURR,"")) I PCN="" Q
. S PROU=$P(^APCMMUCN(PCN,0),U,3)
Q PROU
;
CURREP() ;EP - Get current performance report
NEW PREP,CURR
I '$$PATCH^XPDUTL("APCM*1.0*2") Q ""
S PREP="INTERIM STAGE 1 2013"
S CURR=$P($G(^BQI(90508,1,9)),U,3)
I CURR'="" S PREP=CURR
Q PREP
;
PRFPGL(REPORT) ;EP - Get preferred performance report global
I $G(REPORT)="" Q $$CURPGL()
NEW PCN,PGB,PGLOB
S PCN=$O(^APCMMUCN("B",REPORT,"")) I PCN="" Q $$CURPGL()
S PGB=$P(^APCMMUCN(PCN,0),U,4)
S PGLOB=$$ROOT^DILFD(PGB,"",1)
Q PGLOB
;
PRFPRT(REPORT) ;EP - Get preferred performance report routine
I $G(REPORT)="" Q $$CURPRT()
NEW PCN,PROU
S PCN=$O(^APCMMUCN("B",REPORT,"")) I PCN="" Q $$CURPRT()
S PROU=$P(^APCMMUCN(PCN,0),U,3)
Q PROU
BQIMUTAB ;VNGT/HS/ALA-MU Tables ; 25 Feb 2011 1:09 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 ;
+3 ;
ITM(DATA,TYPE,REPORT) ; EP -- BQI GET MU MEASURES
+1 ; Input Parameters
+2 ; TYPE = E for Provider, H for Hospital, null for both
+3 NEW UID,II,MN,MDATA,TIP,TP,PGLOB,HDR
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQIMUITM",UID))
+6 KILL @DATA
+7 SET II=0
SET TYPE=$GET(TYPE,"")
SET REPORT=$GET(REPORT,"")
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+9 ;
+10 SET HDR="T00030ID^T00001TYPE^T00050NAME^T00001MEASTYPE^T00001SET^T01024TOOLTIP"
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;S PGLOB=$$CURPGL()
+13 SET PGLOB=$$PRFPGL^BQIMUTAB(REPORT)
+14 SET MN=0
+15 FOR
SET MN=$ORDER(@PGLOB@(MN))
IF 'MN
QUIT
Begin DoDot:1
+16 IF TYPE'=""
IF $PIECE(@PGLOB@(MN,0),U,2)'=TYPE
QUIT
+17 SET MDATA=@PGLOB@(MN,0)
+18 ; Ignore attestation measures
+19 IF $PIECE(MDATA,U,6)="A"
QUIT
+20 SET TIP=""
SET TP=0
+21 FOR
SET TP=$ORDER(@PGLOB@(MN,23,TP))
IF 'TP
QUIT
SET TIP=TIP_@PGLOB@(MN,23,TP,0)_$CHAR(10)
+22 SET TP=0
SET TIP=TIP_"TARGET: "_$CHAR(10)
+23 FOR
SET TP=$ORDER(@PGLOB@(MN,13,TP))
IF 'TP
QUIT
SET TIP=TIP_@PGLOB@(MN,13,TP,0)_$CHAR(10)
+24 SET II=II+1
SET @DATA@(II)=$PIECE(MDATA,U,1)_U_$PIECE(MDATA,U,2)_U_$PIECE(MDATA,U,5)_U_$PIECE(MDATA,U,6)_U_$PIECE(MDATA,U,3)_U_TIP_$CHAR(30)
End DoDot:1
+25 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
MURP(DATA,TYPE) ; EP -- BQI MU PERF REPORT
+1 NEW UID,II,MN,REP
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIMURPT",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00030REPORT"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 IF '$$PATCH^XPDUTL("APCM*1.0*2")
GOTO DONE
+11 SET MN=0
+12 FOR
SET MN=$ORDER(^APCMMUCN(MN))
IF 'MN
QUIT
Begin DoDot:1
+13 IF TYPE="SITE"
SET II=II+1
SET @DATA@(II)=$PIECE(^APCMMUCN(MN,0),U,1)_$CHAR(30)
QUIT
+14 SET REP=$PIECE(^APCMMUCN(MN,0),U,1)
+15 ;I '$D(^BQIPROV("AC",REP)) Q
+16 SET II=II+1
SET @DATA@(II)=REP_$CHAR(30)
End DoDot:1
+17 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+18 QUIT
+19 ;
GCUR(DATA,FAKE) ; EP -- BQI GET MU CURRENT PERF
+1 NEW UID,II,MN
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIMUCUR",UID))
+4 KILL @DATA
+5 SET II=0
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00030REPORT"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 IF '$$PATCH^XPDUTL("APCM*1.0*2")
GOTO DONE
+11 SET II=II+1
SET @DATA@(II)=$PIECE($GET(^BQI(90508,1,9)),U,3)_$CHAR(30)
+12 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+13 QUIT
+14 ;
UCUR(DATA,REP) ; EP -- BQI SET MU CURRENT PERF
+1 NEW UID,II,ERROR
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIMUCUP",UID))
+4 KILL @DATA
+5 SET II=0
SET REP=$GET(REP,"")
+6 SET @DATA@(II)="I00010RESULT^T00030MSG"_$CHAR(30)
+7 ;
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+9 SET BQIUPD(90508,"1,",9.03)=REP
+10 SET RESULT=1
SET MSG=""
+11 DO FILE^DIE("","BQIUPD","ERROR")
+12 IF $DATA(ERROR)
SET RESULT=-1
SET MSG=$GET(ERROR("DIERR",1,"TEXT",1))
+13 SET II=II+1
SET @DATA@(II)=RESULT_U_MSG_$CHAR(30)
+14 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+15 QUIT
+16 ;
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 ;
MUDT(DATA,MUTYP) ;EP -- BQI GET MU DATES
+1 NEW UID,II
+2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DATA=$NAME(^TMP("BQIMUDT",UID))
+4 KILL @DATA
+5 SET II=0
SET TYPE=$GET(TYPE,"")
+6 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+7 ;
+8 SET HDR="T00010ID^T00030"
+9 SET @DATA@(II)=HDR_$CHAR(30)
+10 SET II=II+1
SET @DATA@(II)="30^1 Month"_$CHAR(30)
+11 SET II=II+1
SET @DATA@(II)="90^90 Days"_$CHAR(30)
+12 SET II=II+1
SET @DATA@(II)="12^1 Year"_$CHAR(30)
+13 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+14 QUIT
+15 ;
CQM(DATA,TYPE) ; EP -- BQI GET MU CQ MEASURES
+1 ; Input Parameters
+2 ; TYPE = E for Provider, H for Hospital, null for both
+3 NEW UID,II,MN,MDATA,TIP,TP,MTYPE,MSN,QFL,BQIDATA
+4 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+5 SET DATA=$NAME(^TMP("BQIMUCQM",UID))
+6 KILL @DATA
+7 SET II=0
SET TYPE=$GET(TYPE,"")
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER"
+9 ;
+10 SET HDR="T00030ID^T00001TYPE^T00050NAME^T01024TOOLTIP"
+11 SET @DATA@(II)=HDR_$CHAR(30)
+12 ;
+13 SET MN=0
+14 FOR
SET MN=$ORDER(^BGPMUIND(90596.11,MN))
IF 'MN
QUIT
Begin DoDot:1
+15 IF TYPE'=""
SET QFL=0
Begin DoDot:2
+16 SET MSN=$PIECE(^BGPMUIND(90596.11,MN,0),U,1)
+17 IF $GET(^BGPMUIND(90595.11,MSN,0))=""
QUIT
+18 IF TYPE="E"
IF $PIECE(^BGPMUIND(90595.11,MSN,0),U,4)="H"
SET QFL=1
QUIT
+19 IF TYPE="H"
IF $PIECE(^BGPMUIND(90595.11,MSN,0),U,4)'="H"
SET QFL=1
QUIT
End DoDot:2
IF QFL
QUIT
+20 ;
+21 SET MDATA=^BGPMUIND(90596.11,MN,0)
+22 SET MSN=$PIECE(^BGPMUIND(90596.11,MN,0),U,1)
+23 IF $GET(^BGPMUIND(90595.11,MSN,0))=""
QUIT
+24 SET MTYPE=$$GET1^DIQ(90595.11,MSN_",",.04,"E")
+25 SET BQIDATA=$GET(^BGPMUIND(90596.11,MN,17))
IF BQIDATA=""
QUIT
+26 SET TIP=$GET(^BGPMUIND(90595.11,MSN,18,1,0))_$CHAR(10)
SET TP=0
+27 FOR
SET TP=$ORDER(^BGPMUIND(90596.11,MN,18,TP))
IF 'TP
QUIT
SET TIP=TIP_^BGPMUIND(90596.11,MN,18,TP,0)_$CHAR(10)
+28 SET II=II+1
SET @DATA@(II)=$PIECE(MDATA,U,4)_U_MTYPE_U_$PIECE(BQIDATA,U,3)_U_TIP_$CHAR(30)
End DoDot:1
+29 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+30 QUIT
+31 ;
CURPGL() ;EP - Get current performance report global
+1 NEW CURR,PCN,PGB,PGLOB
+2 SET PGLOB="^APCMMUM"
+3 SET CURR=$PIECE($GET(^BQI(90508,1,9)),U,3)
+4 IF CURR'=""
Begin DoDot:1
+5 SET PCN=$ORDER(^APCMMUCN("B",CURR,""))
IF PCN=""
QUIT
+6 SET PGB=$PIECE(^APCMMUCN(PCN,0),U,4)
+7 SET PGLOB=$$ROOT^DILFD(PGB,"",1)
End DoDot:1
+8 QUIT PGLOB
+9 ;
CURPRT() ;EP - Get current performance report routine
+1 NEW PROU,CURR,PCN
+2 SET PROU="APCM11E1"
+3 SET CURR=$PIECE($GET(^BQI(90508,1,9)),U,3)
+4 IF CURR'=""
Begin DoDot:1
+5 SET PCN=$ORDER(^APCMMUCN("B",CURR,""))
IF PCN=""
QUIT
+6 SET PROU=$PIECE(^APCMMUCN(PCN,0),U,3)
End DoDot:1
+7 QUIT PROU
+8 ;
CURREP() ;EP - Get current performance report
+1 NEW PREP,CURR
+2 IF '$$PATCH^XPDUTL("APCM*1.0*2")
QUIT ""
+3 SET PREP="INTERIM STAGE 1 2013"
+4 SET CURR=$PIECE($GET(^BQI(90508,1,9)),U,3)
+5 IF CURR'=""
SET PREP=CURR
+6 QUIT PREP
+7 ;
PRFPGL(REPORT) ;EP - Get preferred performance report global
+1 IF $GET(REPORT)=""
QUIT $$CURPGL()
+2 NEW PCN,PGB,PGLOB
+3 SET PCN=$ORDER(^APCMMUCN("B",REPORT,""))
IF PCN=""
QUIT $$CURPGL()
+4 SET PGB=$PIECE(^APCMMUCN(PCN,0),U,4)
+5 SET PGLOB=$$ROOT^DILFD(PGB,"",1)
+6 QUIT PGLOB
+7 ;
PRFPRT(REPORT) ;EP - Get preferred performance report routine
+1 IF $GET(REPORT)=""
QUIT $$CURPRT()
+2 NEW PCN,PROU
+3 SET PCN=$ORDER(^APCMMUCN("B",REPORT,""))
IF PCN=""
QUIT $$CURPRT()
+4 SET PROU=$PIECE(^APCMMUCN(PCN,0),U,3)
+5 QUIT PROU
