Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQIMUTAB

BQIMUTAB.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1. ITM(DATA,TYPE,REPORT) ; EP -- BQI GET MU MEASURES
  1.  ; Input Parameters
  1.  ;   TYPE = E for Provider, H for Hospital, null for both
  1.  NEW UID,II,MN,MDATA,TIP,TP,PGLOB,HDR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUITM",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,""),REPORT=$G(REPORT,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00030ID^T00001TYPE^T00050NAME^T00001MEASTYPE^T00001SET^T01024TOOLTIP"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;S PGLOB=$$CURPGL()
  1.  S PGLOB=$$PRFPGL^BQIMUTAB(REPORT)
  1.  S MN=0
  1.  F  S MN=$O(@PGLOB@(MN)) Q:'MN  D
  1.  . I TYPE'="",$P(@PGLOB@(MN,0),U,2)'=TYPE Q
  1.  . S MDATA=@PGLOB@(MN,0)
  1.  . ; Ignore attestation measures
  1.  . I $P(MDATA,U,6)="A" Q
  1.  . S TIP="",TP=0
  1.  . F  S TP=$O(@PGLOB@(MN,23,TP)) Q:'TP  S TIP=TIP_@PGLOB@(MN,23,TP,0)_$C(10)
  1.  . S TP=0,TIP=TIP_"TARGET: "_$C(10)
  1.  . F  S TP=$O(@PGLOB@(MN,13,TP)) Q:'TP  S TIP=TIP_@PGLOB@(MN,13,TP,0)_$C(10)
  1.  . 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)
  1.  ;
  1. DONE ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MURP(DATA,TYPE) ; EP -- BQI MU PERF REPORT
  1.  NEW UID,II,MN,REP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMURPT",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00030REPORT"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  I '$$PATCH^XPDUTL("APCM*1.0*2") G DONE
  1.  S MN=0
  1.  F  S MN=$O(^APCMMUCN(MN)) Q:'MN  D
  1.  . I TYPE="SITE" S II=II+1,@DATA@(II)=$P(^APCMMUCN(MN,0),U,1)_$C(30) Q
  1.  . S REP=$P(^APCMMUCN(MN,0),U,1)
  1.  . ;I '$D(^BQIPROV("AC",REP)) Q
  1.  . S II=II+1,@DATA@(II)=REP_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. GCUR(DATA,FAKE) ; EP -- BQI GET MU CURRENT PERF
  1.  NEW UID,II,MN
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUCUR",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00030REPORT"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  I '$$PATCH^XPDUTL("APCM*1.0*2") G DONE
  1.  S II=II+1,@DATA@(II)=$P($G(^BQI(90508,1,9)),U,3)_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UCUR(DATA,REP) ; EP -- BQI SET MU CURRENT PERF
  1.  NEW UID,II,ERROR
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUCUP",UID))
  1.  K @DATA
  1.  S II=0,REP=$G(REP,"")
  1.  S @DATA@(II)="I00010RESULT^T00030MSG"_$C(30)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S BQIUPD(90508,"1,",9.03)=REP
  1.  S RESULT=1,MSG=""
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  I $D(ERROR) S RESULT=-1,MSG=$G(ERROR("DIERR",1,"TEXT",1))
  1.  S II=II+1,@DATA@(II)=RESULT_U_MSG_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. MUDT(DATA,MUTYP) ;EP -- BQI GET MU DATES
  1.  NEW UID,II
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUDT",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00010ID^T00030"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  S II=II+1,@DATA@(II)="30^1 Month"_$C(30)
  1.  S II=II+1,@DATA@(II)="90^90 Days"_$C(30)
  1.  S II=II+1,@DATA@(II)="12^1 Year"_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CQM(DATA,TYPE) ; EP -- BQI GET MU CQ MEASURES
  1.  ; Input Parameters
  1.  ;   TYPE = E for Provider, H for Hospital, null for both
  1.  NEW UID,II,MN,MDATA,TIP,TP,MTYPE,MSN,QFL,BQIDATA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUCQM",UID))
  1.  K @DATA
  1.  S II=0,TYPE=$G(TYPE,"")
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUTAB D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S HDR="T00030ID^T00001TYPE^T00050NAME^T01024TOOLTIP"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  S MN=0
  1.  F  S MN=$O(^BGPMUIND(90596.11,MN)) Q:'MN  D
  1.  . I TYPE'="" S QFL=0 D  Q:QFL
  1.  .. S MSN=$P(^BGPMUIND(90596.11,MN,0),U,1)
  1.  .. I $G(^BGPMUIND(90595.11,MSN,0))="" Q
  1.  .. I TYPE="E",$P(^BGPMUIND(90595.11,MSN,0),U,4)="H" S QFL=1 Q
  1.  .. I TYPE="H",$P(^BGPMUIND(90595.11,MSN,0),U,4)'="H" S QFL=1 Q
  1.  . ;
  1.  . S MDATA=^BGPMUIND(90596.11,MN,0)
  1.  . S MSN=$P(^BGPMUIND(90596.11,MN,0),U,1)
  1.  . I $G(^BGPMUIND(90595.11,MSN,0))="" Q
  1.  . S MTYPE=$$GET1^DIQ(90595.11,MSN_",",.04,"E")
  1.  . S BQIDATA=$G(^BGPMUIND(90596.11,MN,17)) I BQIDATA="" Q
  1.  . S TIP=$G(^BGPMUIND(90595.11,MSN,18,1,0))_$C(10),TP=0
  1.  . F  S TP=$O(^BGPMUIND(90596.11,MN,18,TP)) Q:'TP  S TIP=TIP_^BGPMUIND(90596.11,MN,18,TP,0)_$C(10)
  1.  . S II=II+1,@DATA@(II)=$P(MDATA,U,4)_U_MTYPE_U_$P(BQIDATA,U,3)_U_TIP_$C(30)
  1.   S II=II+1,@DATA@(II)=$C(31)
  1.   Q
  1.   ;
  1. CURPGL() ;EP - Get current performance report global
  1.  NEW CURR,PCN,PGB,PGLOB
  1.  S PGLOB="^APCMMUM"
  1.  S CURR=$P($G(^BQI(90508,1,9)),U,3)
  1.  I CURR'="" D
  1.  . S PCN=$O(^APCMMUCN("B",CURR,"")) I PCN="" Q
  1.  . S PGB=$P(^APCMMUCN(PCN,0),U,4)
  1.  . S PGLOB=$$ROOT^DILFD(PGB,"",1)
  1.  Q PGLOB
  1.  ;
  1. CURPRT() ;EP - Get current performance report routine
  1.  NEW PROU,CURR,PCN
  1.  S PROU="APCM11E1"
  1.  S CURR=$P($G(^BQI(90508,1,9)),U,3)
  1.  I CURR'="" D
  1.  . S PCN=$O(^APCMMUCN("B",CURR,"")) I PCN="" Q
  1.  . S PROU=$P(^APCMMUCN(PCN,0),U,3)
  1.  Q PROU
  1.  ;
  1. CURREP() ;EP - Get current performance report
  1.  NEW PREP,CURR
  1.  I '$$PATCH^XPDUTL("APCM*1.0*2") Q ""
  1.  S PREP="INTERIM STAGE 1 2013"
  1.  S CURR=$P($G(^BQI(90508,1,9)),U,3)
  1.  I CURR'="" S PREP=CURR
  1.  Q PREP
  1.  ;
  1. PRFPGL(REPORT) ;EP - Get preferred performance report global
  1.  I $G(REPORT)="" Q $$CURPGL()
  1.  NEW PCN,PGB,PGLOB
  1.  S PCN=$O(^APCMMUCN("B",REPORT,"")) I PCN="" Q $$CURPGL()
  1.  S PGB=$P(^APCMMUCN(PCN,0),U,4)
  1.  S PGLOB=$$ROOT^DILFD(PGB,"",1)
  1.  Q PGLOB
  1.  ;
  1. PRFPRT(REPORT) ;EP - Get preferred performance report routine
  1.  I $G(REPORT)="" Q $$CURPRT()
  1.  NEW PCN,PROU
  1.  S PCN=$O(^APCMMUCN("B",REPORT,"")) I PCN="" Q $$CURPRT()
  1.  S PROU=$P(^APCMMUCN(PCN,0),U,3)
  1.  Q PROU