BQIGPRA6 ;GDIT/HS/ALA-Update all patients for selected measures ; 26 Sep 2012 9:59 AM
;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
;
Q
;
EN ;EP
;Description
; Find GPRA for a single measure or a list of measures for all patients
;Input
; MLIST = List of CRS Measures
;
NEW UID,II,BQIGREF,BQIDATA,BQIROU,BGPIND,BGPBD,BGPED,BGPBBD,BGPBED,X,DFN
NEW BGPPBD,BGPPED,BGPPER,BGPQTR,BGPRTYPE,BGPRPT,BGP3YE,BGPP3YE,BGPB3YE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIGPRA6 D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S BQIGREF=$NA(^TMP("BQIGPRA",UID))
S BQIDATA=$NA(^BQIPAT)
K @BQIGREF
; Set the DATE/TIME GPRA STARTED field
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.04)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.06)=1
S BQIUPD(90508,DA_",",24.05)=$G(ZTSK)
D FILE^DIE("","BQIUPD")
K BQIUPD
;
; Initialize data
D INP^BQINIGHT
; If the routine is not defined, quit
I $G(BQIROU)="" Q
;
; If the tag is not defined, quit
I $T(@("BQI^"_BQIROU))="" Q
;
; Initialize GPRA variables
NEW VER,BQX,XN
S VER=$$VERSION^XPDUTL("BGP")
;
I VER>7.0 D
. S BQX=""
. F S BQX=$O(^BQI(90506.1,"AC","G",BQX)) Q:BQX="" D
.. I $P(^BQI(90506.1,BQX,0),U,10)=1 Q
.. S X=$P(^BQI(90506.1,BQX,0),U,1),XN=$P(X,"_",2)
.. S X=$P($G(@BQIMEASG@(XN,0)),U,1) I X'="" S BGPIND(X)=""
;
S DFN=0
F S DFN=$O(^BQIPAT(DFN)) Q:'DFN D FND
;
; Set the DATE/TIME GPRA STOPPED
NEW DA
S DA=$O(^BQI(90508,0)) I 'DA Q
S BQIUPD(90508,DA_",",4.05)=$$NOW^XLFDT()
S BQIUPD(90508,DA_",",4.06)="@"
S BQIUPD(90508,DA_",",24.05)="@"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
Q
;
FND ;EP
; If patient is deceased, don't calculate
I $P($G(^DPT(DFN,.35)),U,1)'="" Q
; If patient has no active HRNs, quit
I '$$HRN^BQIUL1(DFN) Q
; If patient has no visit in last 3 years, quit
I '$$VTHR^BQIUL1(DFN) Q
;
D INP^BQINIGHT
I $G(BQIROU)="" Q
;
I $T(@("BQI^"_BQIROU))="" Q
;
NEW VER,BQX,XN,SIND,IND,MEAS,MCT,CT,GPMEAS
S VER=$$VERSION^XPDUTL("BGP")
;
I VER>7.0 D
. ; initialize the summary indicators for the patient
. S CT=0,SIND=""
. F S SIND=$O(^BQI(90506.1,"AC","G",SIND)) Q:SIND="" D
.. I $P(^BQI(90506.1,SIND,0),U,10)=1 Q
.. S CT=CT+1,BQX=$P(^BQI(90506.1,SIND,0),U,1)
.. S @BQIDATA@(DFN,30,CT,0)=BQX
.. S @BQIDATA@(DFN,30,"B",BQX,CT)=""
.. S ^BQIPAT("AC",BQX,DFN,CT)=""
;
; Define the time frame for the patient
S BGPBD=$$DATE^BQIUL1("T-12M"),BGPED=DT
S BGPBBD="300"_$E(BGPBD,4,7),BGPBED="300"_$E(BGPED,4,7)
S BGPPBD=$$DATE^BQIUL1("T-24M"),BGPPED=$$DATE^BQIUL1("T-12M")
S BGPPER=$E($$DT^XLFDT(),1,3)_"0000"
S BGPQTR=$S(BGPBD>($E(BGPBD,1,3)_"0101")&(BGPBD<($E(BGPBD,1,3)_"0331")):1,BGPBD>($E(BGPBD,1,3)_"0401")&(BGPBD<($E(BGPBD,1,3)_"0630")):2,BGPBD>($E(BGPBD,1,3)_"0701")&(BGPBD<($E(BGPBD,1,3)_"0930")):3,1:4)
S BGPRTYPE=4,BGPRPT=4
S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
;
S BQIPUP(90507.5,DFN_",",.02)=BQIYR
S BQIPUP(90507.5,DFN_",",.03)=BGPBD
S BQIPUP(90507.5,DFN_",",.04)=BGPED
S BQIPUP(90507.5,DFN_",",.05)=$$NOW^XLFDT()
D FILE^DIE("","BQIPUP","ERROR")
K BQIPUP
; Setup taxonomies
I VER>14.1 D
. I $T(UNFOLDTX^BGP8UTL2)="" Q
. D UNFOLDTX^BGP8UTL2
;
D @("BQI^"_BQIROU_"(DFN,.BQIGREF)")
;
K ^XTMP("BGP15TAX",$J),^XTMP("BGPSNOMEDSUBSET",$J)
;
; if the patient doesn't already exist in the iCare Patient file, quit
I $G(^BQIPAT(DFN,0))="" Q
;
; if the patient doesn't meet the GPRA logic for these measures, quit
I '$D(@BQIGREF@(DFN)) Q
;
S IND=0
F S IND=$O(@BQIGREF@(DFN,IND)) Q:IND="" D
. S MEAS=0
. F S MEAS=$O(@BQIGREF@(DFN,IND,MEAS)) Q:MEAS="" D
.. S GPMEAS=BQIYR_"_"_MEAS
.. S MCT=$O(^BQIPAT(DFN,30,"B",GPMEAS,"")) I MCT="" Q
.. S $P(@BQIDATA@(DFN,30,MCT,0),U,2)=$P(@BQIGREF@(DFN,IND),U,2)
.. S $P(@BQIDATA@(DFN,30,MCT,0),U,3)=$P(@BQIGREF@(DFN,IND,MEAS),U,2)
.. S $P(@BQIDATA@(DFN,30,MCT,0),U,4)=$P(@BQIGREF@(DFN,IND,MEAS),U,3)
;
; Create cross-references
K @BQIGREF
;
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
Q
BQIGPRA6 ;GDIT/HS/ALA-Update all patients for selected measures ; 26 Sep 2012 9:59 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;**1**;Dec 19, 2017;Build 12
+2 ;
+3 QUIT
+4 ;
EN ;EP
+1 ;Description
+2 ; Find GPRA for a single measure or a list of measures for all patients
+3 ;Input
+4 ; MLIST = List of CRS Measures
+5 ;
+6 NEW UID,II,BQIGREF,BQIDATA,BQIROU,BGPIND,BGPBD,BGPED,BGPBBD,BGPBED,X,DFN
+7 NEW BGPPBD,BGPPED,BGPPER,BGPQTR,BGPRTYPE,BGPRPT,BGP3YE,BGPP3YE,BGPB3YE
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 ;
+10 SET II=0
+11 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIGPRA6 D UNWIND^%ZTER"
+12 ;
+13 SET BQIGREF=$NAME(^TMP("BQIGPRA",UID))
+14 SET BQIDATA=$NAME(^BQIPAT)
+15 KILL @BQIGREF
+16 ; Set the DATE/TIME GPRA STARTED field
+17 NEW DA
+18 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+19 SET BQIUPD(90508,DA_",",4.04)=$$NOW^XLFDT()
+20 SET BQIUPD(90508,DA_",",4.06)=1
+21 SET BQIUPD(90508,DA_",",24.05)=$GET(ZTSK)
+22 DO FILE^DIE("","BQIUPD")
+23 KILL BQIUPD
+24 ;
+25 ; Initialize data
+26 DO INP^BQINIGHT
+27 ; If the routine is not defined, quit
+28 IF $GET(BQIROU)=""
QUIT
+29 ;
+30 ; If the tag is not defined, quit
+31 IF $TEXT(@("BQI^"_BQIROU))=""
QUIT
+32 ;
+33 ; Initialize GPRA variables
+34 NEW VER,BQX,XN
+35 SET VER=$$VERSION^XPDUTL("BGP")
+36 ;
+37 IF VER>7.0
Begin DoDot:1
+38 SET BQX=""
+39 FOR
SET BQX=$ORDER(^BQI(90506.1,"AC","G",BQX))
IF BQX=""
QUIT
Begin DoDot:2
+40 IF $PIECE(^BQI(90506.1,BQX,0),U,10)=1
QUIT
+41 SET X=$PIECE(^BQI(90506.1,BQX,0),U,1)
SET XN=$PIECE(X,"_",2)
+42 SET X=$PIECE($GET(@BQIMEASG@(XN,0)),U,1)
IF X'=""
SET BGPIND(X)=""
End DoDot:2
End DoDot:1
+43 ;
+44 SET DFN=0
+45 FOR
SET DFN=$ORDER(^BQIPAT(DFN))
IF 'DFN
QUIT
DO FND
+46 ;
+47 ; Set the DATE/TIME GPRA STOPPED
+48 NEW DA
+49 SET DA=$ORDER(^BQI(90508,0))
IF 'DA
QUIT
+50 SET BQIUPD(90508,DA_",",4.05)=$$NOW^XLFDT()
+51 SET BQIUPD(90508,DA_",",4.06)="@"
+52 SET BQIUPD(90508,DA_",",24.05)="@"
+53 DO FILE^DIE("","BQIUPD","ERROR")
+54 KILL BQIUPD
+55 QUIT
+56 ;
FND ;EP
+1 ; If patient is deceased, don't calculate
+2 IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""
QUIT
+3 ; If patient has no active HRNs, quit
+4 IF '$$HRN^BQIUL1(DFN)
QUIT
+5 ; If patient has no visit in last 3 years, quit
+6 IF '$$VTHR^BQIUL1(DFN)
QUIT
+7 ;
+8 DO INP^BQINIGHT
+9 IF $GET(BQIROU)=""
QUIT
+10 ;
+11 IF $TEXT(@("BQI^"_BQIROU))=""
QUIT
+12 ;
+13 NEW VER,BQX,XN,SIND,IND,MEAS,MCT,CT,GPMEAS
+14 SET VER=$$VERSION^XPDUTL("BGP")
+15 ;
+16 IF VER>7.0
Begin DoDot:1
+17 ; initialize the summary indicators for the patient
+18 SET CT=0
SET SIND=""
+19 FOR
SET SIND=$ORDER(^BQI(90506.1,"AC","G",SIND))
IF SIND=""
QUIT
Begin DoDot:2
+20 IF $PIECE(^BQI(90506.1,SIND,0),U,10)=1
QUIT
+21 SET CT=CT+1
SET BQX=$PIECE(^BQI(90506.1,SIND,0),U,1)
+22 SET @BQIDATA@(DFN,30,CT,0)=BQX
+23 SET @BQIDATA@(DFN,30,"B",BQX,CT)=""
+24 SET ^BQIPAT("AC",BQX,DFN,CT)=""
End DoDot:2
End DoDot:1
+25 ;
+26 ; Define the time frame for the patient
+27 SET BGPBD=$$DATE^BQIUL1("T-12M")
SET BGPED=DT
+28 SET BGPBBD="300"_$EXTRACT(BGPBD,4,7)
SET BGPBED="300"_$EXTRACT(BGPED,4,7)
+29 SET BGPPBD=$$DATE^BQIUL1("T-24M")
SET BGPPED=$$DATE^BQIUL1("T-12M")
+30 SET BGPPER=$EXTRACT($$DT^XLFDT(),1,3)_"0000"
+31 SET BGPQTR=$SELECT(BGPBD>($EXTRACT(BGPBD,1,3)_"0101")&(BGPBD<($EXTRACT(BGPBD,1,3)_"0331")):1,BGPBD>($EXTRACT(BGPBD,1,3)_"0401")&(BGPBD<($EXTRACT(BGPBD,1,3)_"0630")):2,BGPBD>($EXTRACT(BGPBD,1,3)_"0701")&(BGPBD<($EXTRACT(BGPBD,1,3)_"0930")):3,1:4
)
+32 SET BGPRTYPE=4
SET BGPRPT=4
+33 SET BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
+34 SET BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
+35 SET BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
+36 ;
+37 SET BQIPUP(90507.5,DFN_",",.02)=BQIYR
+38 SET BQIPUP(90507.5,DFN_",",.03)=BGPBD
+39 SET BQIPUP(90507.5,DFN_",",.04)=BGPED
+40 SET BQIPUP(90507.5,DFN_",",.05)=$$NOW^XLFDT()
+41 DO FILE^DIE("","BQIPUP","ERROR")
+42 KILL BQIPUP
+43 ; Setup taxonomies
+44 IF VER>14.1
Begin DoDot:1
+45 IF $TEXT(UNFOLDTX^BGP8UTL2)=""
QUIT
+46 DO UNFOLDTX^BGP8UTL2
End DoDot:1
+47 ;
+48 DO @("BQI^"_BQIROU_"(DFN,.BQIGREF)")
+49 ;
+50 KILL ^XTMP("BGP15TAX",$JOB),^XTMP("BGPSNOMEDSUBSET",$JOB)
+51 ;
+52 ; if the patient doesn't already exist in the iCare Patient file, quit
+53 IF $GET(^BQIPAT(DFN,0))=""
QUIT
+54 ;
+55 ; if the patient doesn't meet the GPRA logic for these measures, quit
+56 IF '$DATA(@BQIGREF@(DFN))
QUIT
+57 ;
+58 SET IND=0
+59 FOR
SET IND=$ORDER(@BQIGREF@(DFN,IND))
IF IND=""
QUIT
Begin DoDot:1
+60 SET MEAS=0
+61 FOR
SET MEAS=$ORDER(@BQIGREF@(DFN,IND,MEAS))
IF MEAS=""
QUIT
Begin DoDot:2
+62 SET GPMEAS=BQIYR_"_"_MEAS
+63 SET MCT=$ORDER(^BQIPAT(DFN,30,"B",GPMEAS,""))
IF MCT=""
QUIT
+64 SET $PIECE(@BQIDATA@(DFN,30,MCT,0),U,2)=$PIECE(@BQIGREF@(DFN,IND),U,2)
+65 SET $PIECE(@BQIDATA@(DFN,30,MCT,0),U,3)=$PIECE(@BQIGREF@(DFN,IND,MEAS),U,2)
+66 SET $PIECE(@BQIDATA@(DFN,30,MCT,0),U,4)=$PIECE(@BQIGREF@(DFN,IND,MEAS),U,3)
End DoDot:2
End DoDot:1
+67 ;
+68 ; Create cross-references
+69 KILL @BQIGREF
+70 ;
+71 QUIT
+72 ;
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 QUIT
