BQICMPAT.m

BQICMPAT ;GDIT/HS/ALA-Care Mgmt Recalc ; 03 Oct 2014  2:45 PM

 ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14

 ;

 ;

EN(DFN,CRCE) ;EP

 NEW UID,SOURCE,SRIEN,SRCIEN

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S CRCE=$G(CRCE,"")

 I CRCE'="" D

 . S SOURCE=CRCE

 . D SRC(SOURCE) I SRIEN="" Q

 . D CALC

 I CRCE="" S SRIEN="" F  S SRIEN=$O(^BQI(90506.5,"AD",1,SRIEN)) Q:SRIEN=""  D CALC

 Q

 ;

SRC(SOURCE) ; EP

 S SRIEN=$O(^BQI(90506.5,"B",SOURCE,"")) I SRIEN="" Q

 S SRC=$P(^BQI(90506.5,SRIEN,0),U,2)

 Q

 ;

CALC ; EP

 D CLNUP

 I $P($G(^BQI(90506.5,SRIEN,0)),"^",10)=1 Q

 S SOURCE=$P($G(^BQI(90506.5,SRIEN,0)),"^",1)

 S SRC=$P($G(^BQI(90506.5,SRIEN,0)),U,2)

 ; 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 past 3 years

 I '$$VTHR^BQIUL1(DFN) Q

 I SOURCE="DM Audit" D

 . S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),BDMJOB=UID,BDMBTH=$H

 . S CYR=$P($G(^BQI(90508,1,"DM")),U,1),BDMDMRG=$P($G(^BQI(90508,1,"DM")),"^",2)

 . S CIEN=$O(^BQI(90508,1,21,"B",CYR,"")) I CIEN="" Q

 . S PGTHR=$P(^BQI(90508,1,21,CIEN,0),U,2),PGRF=$P(^(0),U,4)

 . K ^XTMP(PGRF,BDMJOB) S ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"

 . S BDMRBD=DT,BDMADAT=DT,BDMTYPE="P",BDMRED=$$FMADD^XLFDT(BDMADAT,-365)

 . S BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365),BDMPD=DFN

 . D @("GATHER^"_PGTHR)

 D PAT^BQIRGASP(DFN,SRC)

 Q

 ;

CLNUP ;EP - Clean up record

 I SRIEN="" Q

 S SRCIEN=$O(^BQIPAT(DFN,60,"B",SRIEN,""))

 I SRCIEN'="" D

 . NEW DA,DIK

 . S DA(1)=DFN,DA=SRCIEN

 . S DIK="^BQIPAT("_DA(1)_",60,"

 . D ^DIK

 Q

BQICMPAT  ;GDIT/HS/ALA-Care Mgmt Recalc ; 03 Oct 2014  2:45 PM

 +1       ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14

 +2       ;

 +3       ;

EN(DFN,CRCE) ;EP

 +1        NEW UID,SOURCE,SRIEN,SRCIEN

 +2        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +3        SET CRCE=$GET(CRCE,"")

 +4        IF CRCE'=""

               Begin DoDot:1

 +5                SET SOURCE=CRCE

 +6                DO SRC(SOURCE)

                   IF SRIEN=""

                       QUIT 

 +7                DO CALC

               End DoDot:1

 +8        IF CRCE=""

               SET SRIEN=""

               FOR 

                   SET SRIEN=$ORDER(^BQI(90506.5,"AD",1,SRIEN))

                   IF SRIEN=""

                       QUIT 

                   DO CALC

 +9        QUIT 

 +10      ;

SRC(SOURCE) ; EP

 +1        SET SRIEN=$ORDER(^BQI(90506.5,"B",SOURCE,""))

           IF SRIEN=""

               QUIT 

 +2        SET SRC=$PIECE(^BQI(90506.5,SRIEN,0),U,2)

 +3        QUIT 

 +4       ;

CALC      ; EP

 +1        DO CLNUP

 +2        IF $PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",10)=1

               QUIT 

 +3        SET SOURCE=$PIECE($GET(^BQI(90506.5,SRIEN,0)),"^",1)

 +4        SET SRC=$PIECE($GET(^BQI(90506.5,SRIEN,0)),U,2)

 +5       ; If patient is deceased, don't calculate

 +6        IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""

               QUIT 

 +7       ; If patient has no active HRNs, quit

 +8        IF '$$HRN^BQIUL1(DFN)

               QUIT 

 +9       ; If patient has no visit in past 3 years

 +10       IF '$$VTHR^BQIUL1(DFN)

               QUIT 

 +11       IF SOURCE="DM Audit"

               Begin DoDot:1

 +12               SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

                   SET BDMJOB=UID

                   SET BDMBTH=$HOROLOG

 +13               SET CYR=$PIECE($GET(^BQI(90508,1,"DM")),U,1)

                   SET BDMDMRG=$PIECE($GET(^BQI(90508,1,"DM")),"^",2)

 +14               SET CIEN=$ORDER(^BQI(90508,1,21,"B",CYR,""))

                   IF CIEN=""

                       QUIT 

 +15               SET PGTHR=$PIECE(^BQI(90508,1,21,CIEN,0),U,2)

                   SET PGRF=$PIECE(^(0),U,4)

 +16               KILL ^XTMP(PGRF,BDMJOB)

                   SET ^XTMP(PGRF,0)=$$FMADD^XLFDT(DT,1)_"^"_DT_"^iCare DM AUDIT"

 +17               SET BDMRBD=DT

                   SET BDMADAT=DT

                   SET BDMTYPE="P"

                   SET BDMRED=$$FMADD^XLFDT(BDMADAT,-365)

 +18               SET BDMBDAT=$$FMADD^XLFDT(BDMADAT,-365)

                   SET BDMPD=DFN

 +19               DO @("GATHER^"_PGTHR)

               End DoDot:1

 +20       DO PAT^BQIRGASP(DFN,SRC)

 +21       QUIT 

 +22      ;

CLNUP     ;EP - Clean up record

 +1        IF SRIEN=""

               QUIT 

 +2        SET SRCIEN=$ORDER(^BQIPAT(DFN,60,"B",SRIEN,""))

 +3        IF SRCIEN'=""

               Begin DoDot:1

 +4                NEW DA,DIK

 +5                SET DA(1)=DFN

                   SET DA=SRCIEN

 +6                SET DIK="^BQIPAT("_DA(1)_",60,"

 +7                DO ^DIK

               End DoDot:1

 +8        QUIT