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