BQITASK2.m

BQITASK2 ;PRXM/HC/ALA-Separate tasks for post-installs ; 31 Jul 2007  11:24 AM

 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 ;

DXC ;EP - Entry point to identify the diagnostic tags

 ; Variables

 ;   BQDEF  - Diag Cat Definition Name

 ;   BQEXEC - Diag Cat special executable program

 ;   BQPRG  - Diag Cat standard executable program

 ;   BQREF  - Taxonomy array reference

 ;   BQGLB  - Temporary global reference

 ;   BQORD  - Order that the category must be determined

 ;           (Some categories depend upon a patient not being

 ;            in another category)

 ;   BQTN   - Diag Cat internal entry number

 ;

 NEW UID

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

 D DXC^BQITASK

 Q

 ;

GPR ;EP - Entry point to get GPRA values for all users

 ;

 NEW UID

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

 D GPR^BQITASK

 Q

 ;

CMG(SOURCE) ;EP - Update a Care Management group

 NEW SRIEN,SRC,RIEN,STAT,DFN,SRCIEN

 I SOURCE="DM Audit" D

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

 . S BQIUPD(90508,"1,",4.16)=$$NOW^XLFDT(),BQIUPD(90508,"1,",4.18)=1

 . D FILE^DIE("","BQIUPD","ERROR")

 S DFN=0

 F  S DFN=$O(^BQIPAT(DFN)) Q:'DFN  D

 . D SRC(SOURCE) 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

 . ; 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="Pediatric",$$AGE^BQIAGE(DFN,"")>21 Q

 . D PAT^BQIRGASP(DFN,SRC)

 K BDMDMRG,BDMJOB,BDMBTH,CYR,CIEN,PGTHR,PGRF,BDMRBD,BDMADAT,BDMTYPE,BDMRED,BMDBDAT,BDMPD

 S BQIUPD(90508,"1,",4.17)=$$NOW^XLFDT(),BQIUPD(90508,"1,",4.18)="@"

 D FILE^DIE("","BQIUPD","ERROR")

 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

 ;

JBDM ; EP Job off a DM Audit update

 I $$GET1^DIQ(90508,"1,",4.18,"I")=1 Q

 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD,NOW

 S NOW=$$NOW^XLFDT(),ZTDTH=DT_".19"

 I $$FMDIFF^XLFDT(ZTDTH,NOW,2)<60 S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)

 S ZTDESC="Update DM Audit",ZTIO=""

 S ZTRTN="CMG^BQITASK2(""DM Audit"")"

 D ^%ZTLOAD

 Q

BQITASK2  ;PRXM/HC/ALA-Separate tasks for post-installs ; 31 Jul 2007  11:24 AM

 +1       ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 +2       ;

DXC       ;EP - Entry point to identify the diagnostic tags

 +1       ; Variables

 +2       ;   BQDEF  - Diag Cat Definition Name

 +3       ;   BQEXEC - Diag Cat special executable program

 +4       ;   BQPRG  - Diag Cat standard executable program

 +5       ;   BQREF  - Taxonomy array reference

 +6       ;   BQGLB  - Temporary global reference

 +7       ;   BQORD  - Order that the category must be determined

 +8       ;           (Some categories depend upon a patient not being

 +9       ;            in another category)

 +10      ;   BQTN   - Diag Cat internal entry number

 +11      ;

 +12       NEW UID

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

 +14       DO DXC^BQITASK

 +15       QUIT 

 +16      ;

GPR       ;EP - Entry point to get GPRA values for all users

 +1       ;

 +2        NEW UID

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

 +4        DO GPR^BQITASK

 +5        QUIT 

 +6       ;

CMG(SOURCE) ;EP - Update a Care Management group

 +1        NEW SRIEN,SRC,RIEN,STAT,DFN,SRCIEN

 +2        IF SOURCE="DM Audit"

               Begin DoDot:1

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

 +4                SET BQIUPD(90508,"1,",4.16)=$$NOW^XLFDT()

                   SET BQIUPD(90508,"1,",4.18)=1

 +5                DO FILE^DIE("","BQIUPD","ERROR")

               End DoDot:1

 +6        SET DFN=0

 +7        FOR 

               SET DFN=$ORDER(^BQIPAT(DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +8                DO SRC(SOURCE)

                   IF SRIEN=""

                       QUIT 

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

 +10               IF SRCIEN'=""

                       Begin DoDot:2

 +11                       NEW DA,DIK

 +12                       SET DA(1)=DFN

                           SET DA=SRCIEN

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

 +14                       DO ^DIK

                       End DoDot:2

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

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

                       QUIT 

 +17      ; If patient has no active HRNs, quit

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

                       QUIT 

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

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

                       QUIT 

 +21               IF SOURCE="Pediatric"

                       IF $$AGE^BQIAGE(DFN,"")>21

                           QUIT 

 +22               DO PAT^BQIRGASP(DFN,SRC)

               End DoDot:1

 +23       KILL BDMDMRG,BDMJOB,BDMBTH,CYR,CIEN,PGTHR,PGRF,BDMRBD,BDMADAT,BDMTYPE,BDMRED,BMDBDAT,BDMPD

 +24       SET BQIUPD(90508,"1,",4.17)=$$NOW^XLFDT()

           SET BQIUPD(90508,"1,",4.18)="@"

 +25       DO FILE^DIE("","BQIUPD","ERROR")

 +26       QUIT 

 +27      ;

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       ;

JBDM      ; EP Job off a DM Audit update

 +1        IF $$GET1^DIQ(90508,"1,",4.18,"I")=1

               QUIT 

 +2        NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD,NOW

 +3        SET NOW=$$NOW^XLFDT()

           SET ZTDTH=DT_".19"

 +4        IF $$FMDIFF^XLFDT(ZTDTH,NOW,2)<60

               SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,15)

 +5        SET ZTDESC="Update DM Audit"

           SET ZTIO=""

 +6        SET ZTRTN="CMG^BQITASK2(""DM Audit"")"

 +7        DO ^%ZTLOAD

 +8        QUIT