- 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
