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

BQIRMAGG.m

Go to the documentation of this file. 
  1. BQIRMAGG ;PRXM/HC/ALA-Reminders Aggregate ; 16 Mar 2007  4:11 PM
  1.  ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,OWNR,PLIEN) ;EP -- BQI GET REMINDERS AGGREGATE
  1.  ;Description - Entry point for the panel
  1.  NEW UID,II,DFN,AGGREG,REM,PRCUR,PROVR,RCAT,RCLIN,REMNM,RMCODE,NREMNM
  1.  NEW RIEN,GRDT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIRMAGG",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRMAGG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010MEAS_IEN^T00030CATEGORY^T00030CLIN_GROUP^T00050REMINDER^T00015CODE^I00010PATS_ELIGIBLE^I00010PAT_CURRENT^N00010PER_CURRENT^I00010PAT_OVERDUE^N00010PER_OVERDUE"_$C(30)
  1.  S DFN=0,GRDT=$$DATE^BQIUL1("T-30")
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D RPT
  1.  ;
  1.  S REMNM=""
  1.  F  S REMNM=$O(AGGREG(REMNM)) Q:REMNM=""  D
  1.  . S RMCODE=""
  1.  . F  S RMCODE=$O(AGGREG(REMNM,RMCODE)) Q:RMCODE=""  D
  1.  .. ;S PRCUR=$J(($P(AGGREG(REMNM,RMCODE),U,2)/$P(AGGREG(REMNM,RMCODE),U,1))*100,3,1)_"%"
  1.  .. S PRCUR=$J(($P(AGGREG(REMNM,RMCODE),U,2)/$P(AGGREG(REMNM,RMCODE),U,1))*100,3,1)
  1.  .. ;S PROVR=$J(($P(AGGREG(REMNM,RMCODE),U,3)/$P(AGGREG(REMNM,RMCODE),U,1))*100,3,1)_"%"
  1.  .. S PROVR=$J(($P(AGGREG(REMNM,RMCODE),U,3)/$P(AGGREG(REMNM,RMCODE),U,1))*100,3,1)
  1.  .. S RIEN=$$FIND1^DIC(90506.1,"","X",RMCODE,"B","","ERROR")
  1.  .. ;S RCAT=$$GET1^DIQ(90506.1,RIEN_",",2.03,"E")
  1.  .. ;S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",2.05,"E")
  1.  .. S RCAT=$$GET1^DIQ(90506.1,RIEN_",",3.03,"E")
  1.  .. S RCLIN=$$GET1^DIQ(90506.1,RIEN_",",3.02,"E")
  1.  .. I REMNM'?.U S NREMNM=REMNM
  1.  .. I REMNM?.UP S NREMNM=$$LOWER^VALM1(REMNM)
  1.  .. I NREMNM="Breast Mri" S NREMNM="Breast MRI"
  1.  .. S II=II+1,@DATA@(II)=RIEN_U_RCAT_U_RCLIN_U_NREMNM_U_RMCODE_U_$P(AGGREG(REMNM,RMCODE),U,1)_U_$P(AGGREG(REMNM,RMCODE),U,2)_U_PRCUR_U_$P(AGGREG(REMNM,RMCODE),U,3)_U_PROVR_$C(30)
  1.  ;
  1. DONE 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. RPT ;
  1.  ;  If patient is 'removed', don't include
  1.  I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  ;
  1.  NEW RDATA,RIEN,DUE,LAST,CT,PELIG,PCUR,POVR,REM,REMNM,RMCODE,DIEN
  1.  S RIEN=0
  1.  F  S RIEN=$O(^BQIPAT(DFN,40,RIEN)) Q:'RIEN  D
  1.  . S RDATA=^BQIPAT(DFN,40,RIEN,0)
  1.  . S CT=0,PELIG=0,PCUR=0,POVR=0
  1.  . S RMCODE=$P(RDATA,U,1)
  1.  . S DIEN=$O(^BQI(90506.1,"B",RMCODE,"")) Q:DIEN=""
  1.  . ; If it's inactive reminder, quit
  1.  . I $P(^BQI(90506.1,DIEN,0),U,10)=1 Q
  1.  . ; If it's a register reminder, quit
  1.  . ;I $$GET1^DIQ(90506.1,DIEN_",",2.03,"E")="CARE MANAGEMENT" Q
  1.  . I $$GET1^DIQ(90506.1,DIEN_",",3.03,"E")="CARE MANAGEMENT" Q
  1.  . S REMNM=$P(^BQI(90506.1,DIEN,0),U,3)
  1.  . ; NDA patients have no data so CT should be 0
  1.  . F I=2:1:4 S:$P(RDATA,U,I)'="" CT=CT+1
  1.  . I CT=0 Q
  1.  . ; EHR reminders return a N/A
  1.  . I $P(RDATA,U,3)="N/A" Q
  1.  . S PELIG=PELIG+1
  1.  . I CT'=0 D
  1.  .. S DUE=$P(RDATA,U,4),LAST=$P(RDATA,U,2)
  1.  .. I LAST="",DUE="" Q
  1.  .. ;I LAST'="",DUE'="" D
  1.  .. I DUE'="" D
  1.  ... I DUE<GRDT S POVR=POVR+1 Q
  1.  ... ;E  S PCUR=PCUR+1
  1.  ... I DUE>DT S PCUR=PCUR+1
  1.  .. ;I LAST'="",DUE="",LAST<GRDT S POVR=POVR+1
  1.  . S $P(AGGREG(REMNM,RMCODE),U,1)=$P($G(AGGREG(REMNM,RMCODE)),U,1)+PELIG
  1.  . S $P(AGGREG(REMNM,RMCODE),U,2)=$P($G(AGGREG(REMNM,RMCODE)),U,2)+PCUR
  1.  . S $P(AGGREG(REMNM,RMCODE),U,3)=$P($G(AGGREG(REMNM,RMCODE)),U,3)+POVR
  1.  Q