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

BQIGPRA.m

Go to the documentation of this file. 
  1. BQIGPRA ;PRXM/HC/ALA-GPRA Aggregate Call ; 24 Oct 2005  1:11 PM
  1.  ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
  1.  ;
  1.  Q
  1.  ;
  1. AGG(DATA,OWNR,PLIEN) ; EP -- BQI GET GPRA AGGREGATE
  1.  NEW UID,II,PLID,DFN,TOTP,BQIIND,BQICAT,MDESC,TWTEN,NCURR,NUM,DEN,GOAL
  1.  NEW TITLE,ORDER,CAT,BQIYR,FDT,TDT,RPERIOD,BQIMEASF,BQIND,BQMEAS,BQIEN
  1.  NEW SUM,PER,VALUE,X,TDATA,YCURR,CLIN,BQICLN,MSIEN,PIND,YEAR,BQIY,BQIH
  1.  NEW BQIINDF,BQIINDG,BQIMEASG,NAFLG,TPERIOD,BMEAS,GDATA,GNUM,GDEN,TIT
  1.  NEW IPC,BQCODE
  1.  S DFN=0,II=0,PLID=$$PLID^BQIUG1(OWNR,PLIEN)
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIGPAGG",UID)),TDATA=$NA(^TMP("BQIGAGG",UID))
  1.  K @DATA,@TDATA
  1.  ;
  1.  ;S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^T000202010 GOAL^T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^I00010DENOMINATOR^N00010PERCENT"_$C(30)
  1.  S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^"
  1.  S @DATA@(II)=@DATA@(II)_"I00010NUMERATOR^I00010DENOMINATOR^N00010PERCENT^T00030HP_GOAL_2020"_$C(30)
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S YEAR=$$GET1^DIQ(90508,1_",",2,"E")
  1.  S BQIY=$$LKP^BQIGPUTL(YEAR)
  1.  D GFN^BQIGPUTL(BQIH,BQIY)
  1.  S BQIINDG=$$ROOT^DILFD(BQIINDF,"",1)
  1.  S BQIMEASG=$$ROOT^DILFD(BQIMEASF,"",1)
  1.  S VER=$$VERSION^XPDUTL("BGP")
  1.  ;
  1.  S MSIEN=""
  1.  F  S MSIEN=$O(^BQI(90506.1,"AC","G",MSIEN)) Q:MSIEN=""  D
  1.  . I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
  1.  . D INIT(.VER,.MSIEN)
  1.  ;
  1.  S DFN=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D RPT(.VER)
  1.  ;
  1.  NEW DA,IENS
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  S TOTP=$$GET1^DIQ(90505.01,IENS,.1,"E")
  1.  ;
  1.  S CAT=""
  1.  F  S CAT=$O(@TDATA@(CAT)) Q:CAT=""  D
  1.  . S CLIN=""
  1.  . F  S CLIN=$O(@TDATA@(CAT,CLIN)) Q:CLIN=""  D
  1.  .. S TIT=""
  1.  .. F  S TIT=$O(@TDATA@(CAT,CLIN,TIT)) Q:TIT=""  D
  1.  ... S BQIEN=""
  1.  ... F  S BQIEN=$O(@TDATA@(CAT,CLIN,TIT,BQIEN)) Q:BQIEN=""  D
  1.  .... S GDATA=@TDATA@(CAT,CLIN,TIT,BQIEN)
  1.  .... S GNUM=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"NUM"))
  1.  .... S GDEN=$G(@TDATA@(CAT,CLIN,TIT,BQIEN,"DEN"))
  1.  .... D DEF(GDATA,GNUM,GDEN)
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  K @TDATA
  1.  Q
  1.  ;
  1. DEF(GDATA,GNUM,GDEN) ;
  1.  S BQICAT=$P(GDATA,"^",1)
  1.  S BQICLN=$P(GDATA,"^",2)
  1.  S BQMEAS=$P(GDATA,"^",3)
  1.  S MDESC=$P(GDATA,"^",4)
  1.  ;S TWTEN=$P(GDATA,"^",5)
  1.  S NCURR=$P(GDATA,"^",5)
  1.  S YCURR=$P(GDATA,"^",6)
  1.  S RPERIOD=$P(GDATA,"^",7) S:RPERIOD="" RPERIOD=$G(TPERIOD)
  1.  S VALUE=$P(GDATA,"^",8)
  1.  S NAFLG=$P(GDATA,"^",9)
  1.  S GOAL=$P(GDATA,"^",10)
  1.  ;
  1.  S NUM=+$G(GNUM)
  1.  S DEN=+$G(GDEN)
  1.  I DEN=0 S PER=-1
  1.  I NUM=0,DEN'=0 S PER=0
  1.  ;I NUM=0,DEN=0 S PER=0
  1.  I NUM=0,DEN=0 S PER=-1
  1.  I NAFLG=1,PER=0 S PER=-1
  1.  I NUM'=0,DEN'=0 S PER=(NUM/DEN)*100,PER=$J(PER,3,1)
  1.  I NAFLG=1 S DEN="-"
  1.  S II=II+1,@DATA@(II)=RPERIOD_U_TOTP_U_BQICAT_U_BQICLN_U_BQMEAS_U_NCURR_U_YCURR_U_MDESC_U_NUM_U_DEN_U_PER_U_GOAL_$C(30)
  1.  Q
  1.  ;
  1. RPT(VER) ;  Get the CRS Clinical Performance information
  1.  ;  If patient is 'removed', don't include
  1.  I $P($G(^BQICARE(OWNR,1,PLIEN,40,DFN,0)),"^",2)="R" Q
  1.  ;
  1.  S BQIND=0
  1.  F  S BQIND=$O(^BQIPAT(DFN,30,BQIND)) Q:'BQIND  D
  1.  . S BQMEAS=$P(^BQIPAT(DFN,30,BQIND,0),U,1),VALUE=$P(^(0),U,2),NUM=$P(^(0),U,3),DEN=$P(^(0),U,4)
  1.  . S MSIEN=$O(^BQI(90506.1,"B",BQMEAS,"")) I MSIEN="" Q
  1.  . I $P(^BQI(90506.1,MSIEN,0),U,10)=1 Q
  1.  . S TITLE=$P(^BQI(90506.1,MSIEN,0),U,3)
  1.  . S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  . S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  . S BQCODE=BQMEAS,BMEAS=$P(BQMEAS,"_",2)
  1.  . ;
  1.  . S BQIYR=$P($G(^BQIPAT(DFN,0)),U,2)
  1.  . S FDT=$P($G(^BQIPAT(DFN,0)),U,3),TDT=$P($G(^BQIPAT(DFN,0)),U,4)
  1.  . S RPERIOD=$$FMTE^XLFDT(FDT,1)_"-"_$$FMTE^XLFDT(TDT,1)
  1.  . ;
  1.  . S SUM=$$GET1^DIQ(BQIMEASF,BMEAS_",",1706,"I")
  1.  . S IPC=$$GET1^DIQ(BQIMEASF,BMEAS_",",1707,"I")
  1.  . I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
  1.  .. S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
  1.  .. I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  . S @TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"NUM"))+NUM
  1.  . S @TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN")=$G(@TDATA@(CAT,CLIN,TITLE,MSIEN,"DEN"))+DEN
  1.  . S $P(@TDATA@(CAT,CLIN,TITLE,MSIEN),U,8)=RPERIOD S:RPERIOD'="" TPERIOD=RPERIOD
  1.  . S $P(@TDATA@(CAT,CLIN,TITLE,MSIEN),U,9)=VALUE
  1.  . K IPC
  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. INIT(VER,MSIEN) ; Initialize array
  1.  S BQMEAS=$P(^BQI(90506.1,MSIEN,0),U,1),TITLE=$P(^(0),U,3)
  1.  S BQCODE=BQMEAS,BQMEAS=$P(BQMEAS,"_",2)
  1.  ;
  1.  S ORDER=TITLE
  1.  S NAFLG=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1704,"I")
  1.  S NAFLG=$S(NAFLG="Y":1,1:0)
  1.  S SUM=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1706,"I")
  1.  S IPC=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1707,"I")
  1.  ;
  1.  S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
  1.  I TWTEN="" S TWTEN=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1503,"E")
  1.  S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1402,"E")
  1.  I NCURR="" S NCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1502,"E")
  1.  S NCURR=$$STRIP^XLFSTR(NCURR," @#&!")
  1.  S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1408,"E")
  1.  I YCURR="" S YCURR=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1508,"E")
  1.  ;
  1.  S GOAL=""
  1.  I $$VERSION^XPDUTL("BGP")>11 D
  1.  . S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1403,"E")
  1.  . I GOAL="" S GOAL=$$GET1^DIQ(BQIMEASF,BQMEAS_",",1903,"E")
  1.  ;
  1.  S CAT=$$GET1^DIQ(90506.1,MSIEN_",",3.03,"E")
  1.  S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  I IPC=1,$$CIPC^BQIIPCUT(BQCODE) D
  1.  . S CAT="IPC",CLIN=$$CLIN^BQIIPCUT(BQCODE)
  1.  . I CLIN="" S CLIN=$$GET1^DIQ(90506.1,MSIEN_",",3.02,"E")
  1.  ;
  1.  S RPERIOD="",VALUE=""
  1.  ;
  1.  S @TDATA@(CAT,CLIN,TITLE,MSIEN)=CAT_U_CLIN_U_MSIEN_U_TITLE_U_NCURR_U_YCURR_U_RPERIOD_U_VALUE_U_NAFLG_U_GOAL
  1.  Q