BQIRGDBA.m

BQIRGDBA ;VNGT/HS/ALA-Diabetes Audit ; 11 Oct 2010  1:07 PM

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

 ;

EN ; Entry Point for all diabetes tagged patients

 S BDMJOB=$J,BDMBTH=$H

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

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

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

 K ^XTMP("BDMDM01",BDMJOB,BDMBTH)

 S BQITGN=$O(^BQI(90506.2,"B","Diabetes",""))

 S RIEN=""

 F  S RIEN=$O(^BQIREG("B",BQITGN,RIEN)) Q:RIEN=""  D

 . S DFN=$P(^BQIREG(RIEN,0),U,2)

 . I '$$ATAG^BQITDUTL(DFN,BQITGN) Q

 . ;S ^XTMP("BDMDM01",BDMJOB,BDMBTH,"PATS",DFN)=""

 . S ^XTMP("BDMDM12",BDMJOB,BDMBTH,"PATS",DFN)=""

 Q

 ;

AUD(DATA,BDMPD) ;EP -- BQI PAT DIABETES AUDIT REPORT

 ;Description

 ;  Generates a Patient's Diabetes Audit Report for a given DFN

 ;

 ;Input

 ;  BDMPD - Patient Internal Entry number (aka DFN)

 ;

 ;Output

 ;  DATA - Name of global in which data is stored(^TMP("BQIRGDBA"))

 ;

 NEW UID,X,BQII,BDMJOB,BDMBTH,BMDRBD,BDMRED,BDMDMRG,BDMADAT,%

 NEW BDMTYPE,BDMBDAT,BDMPREP,IOSL,BDMGUIC,BDMIOSL,BDMLT,BDMOT,%DT

 NEW DTIME,DFN,AMQQTAXN,B,BDM6MBD,BDMARRAY,BDMC,BDMDEP,BDMER,%X,%Y

 NEW BDMPG,BDMQUIT,BDMR,BDMRBD,BDMTYDM,BDMUTT,BDMV,C,D,E,ED,G,M

 NEW HDATE,HSTEXT,I,ICD,J,L,N,T,V,Y,Z,T1,T2,CYR,CIEN,PGTHR,PGPRT,PGRF

 NEW BD,BDMX

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

 S DATA=$NA(^TMP("BQIRGDBA",UID))

 K @DATA

 ;

 S BQII=0

 ;

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIRGDBA D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 ;

 S DFN=BDMPD

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

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

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

 ;

 D HDR

 ;

 I $$TMPFL^BQIUL1("W",UID,DFN) G DONE

 ;

 S BDMJOB=UID,BDMBTH=$H

 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)

 D @("GATHER^"_PGTHR)

 S BDMPREP=1,IOSL=999,DTIME=1

 U IO D @("^"_PGPRT)

 U IO W $C(9)

 ;

 I $$TMPFL^BQIUL1("C") G DONE

 I $$TMPFL^BQIUL1("R",UID,DFN) G DONE

 ;

 F  U IO R HSTEXT:.1 Q:HSTEXT[$C(9)  D

 . S HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^"),HSTEXT=$$CTRL^BQIUL1(HSTEXT)

 . I HSTEXT="" S HSTEXT=" "

 . S BQII=BQII+1,@DATA@(BQII)=HSTEXT_$C(13)_$C(10)

 S BQII=BQII+1,@DATA@(BQII)=$C(30)

 ;

 I $$TMPFL^BQIUL1("C") G DONE

 I $$TMPFL^BQIUL1("D",UID,DFN) G DONE

 ;

DONE ;

 ;

 S BQII=BQII+1,@DATA@(BQII)=$C(31)

 Q

 ;

HDR ;

 S @DATA@(BQII)="T02048REPORT_TEXT"_$C(30)

 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(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)

 I $$TMPFL^BQIUL1("C")

 Q

BQIRGDBA  ;VNGT/HS/ALA-Diabetes Audit ; 11 Oct 2010  1:07 PM

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

 +2       ;

EN        ; Entry Point for all diabetes tagged patients

 +1        SET BDMJOB=$JOB

           SET BDMBTH=$HOROLOG

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

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

           IF CIEN=""

               QUIT 

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

           SET PGPRT=$PIECE(^(0),U,3)

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

 +5        KILL ^XTMP("BDMDM01",BDMJOB,BDMBTH)

 +6        SET BQITGN=$ORDER(^BQI(90506.2,"B","Diabetes",""))

 +7        SET RIEN=""

 +8        FOR 

               SET RIEN=$ORDER(^BQIREG("B",BQITGN,RIEN))

               IF RIEN=""

                   QUIT 

               Begin DoDot:1

 +9                SET DFN=$PIECE(^BQIREG(RIEN,0),U,2)

 +10               IF '$$ATAG^BQITDUTL(DFN,BQITGN)

                       QUIT 

 +11      ;S ^XTMP("BDMDM01",BDMJOB,BDMBTH,"PATS",DFN)=""

 +12               SET ^XTMP("BDMDM12",BDMJOB,BDMBTH,"PATS",DFN)=""

               End DoDot:1

 +13       QUIT 

 +14      ;

AUD(DATA,BDMPD) ;EP -- BQI PAT DIABETES AUDIT REPORT

 +1       ;Description

 +2       ;  Generates a Patient's Diabetes Audit Report for a given DFN

 +3       ;

 +4       ;Input

 +5       ;  BDMPD - Patient Internal Entry number (aka DFN)

 +6       ;

 +7       ;Output

 +8       ;  DATA - Name of global in which data is stored(^TMP("BQIRGDBA"))

 +9       ;

 +10       NEW UID,X,BQII,BDMJOB,BDMBTH,BMDRBD,BDMRED,BDMDMRG,BDMADAT,%

 +11       NEW BDMTYPE,BDMBDAT,BDMPREP,IOSL,BDMGUIC,BDMIOSL,BDMLT,BDMOT,%DT

 +12       NEW DTIME,DFN,AMQQTAXN,B,BDM6MBD,BDMARRAY,BDMC,BDMDEP,BDMER,%X,%Y

 +13       NEW BDMPG,BDMQUIT,BDMR,BDMRBD,BDMTYDM,BDMUTT,BDMV,C,D,E,ED,G,M

 +14       NEW HDATE,HSTEXT,I,ICD,J,L,N,T,V,Y,Z,T1,T2,CYR,CIEN,PGTHR,PGPRT,PGRF

 +15       NEW BD,BDMX

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

 +17       SET DATA=$NAME(^TMP("BQIRGDBA",UID))

 +18       KILL @DATA

 +19      ;

 +20       SET BQII=0

 +21      ;

 +22      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIRGDBA D UNWIND^%ZTER"

 +23      ;

 +24       SET DFN=BDMPD

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

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

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

           IF CIEN=""

               QUIT 

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

           SET PGPRT=$PIECE(^(0),U,3)

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

 +28      ;

 +29       DO HDR

 +30      ;

 +31       IF $$TMPFL^BQIUL1("W",UID,DFN)

               GOTO DONE

 +32      ;

 +33       SET BDMJOB=UID

           SET BDMBTH=$HOROLOG

 +34       KILL ^XTMP(PGRF,BDMJOB)

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

 +35       SET BDMRBD=DT

           SET BDMADAT=DT

           SET BDMTYPE="P"

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

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

 +37       DO @("GATHER^"_PGTHR)

 +38       SET BDMPREP=1

           SET IOSL=999

           SET DTIME=1

 +39       USE IO

           DO @("^"_PGPRT)

 +40       USE IO

           WRITE $CHAR(9)

 +41      ;

 +42       IF $$TMPFL^BQIUL1("C")

               GOTO DONE

 +43       IF $$TMPFL^BQIUL1("R",UID,DFN)

               GOTO DONE

 +44      ;

 +45       FOR 

               USE IO

               READ HSTEXT:.1

               IF HSTEXT[$CHAR(9)

                   QUIT 

               Begin DoDot:1

 +46               SET HSTEXT=$$STRIP^XLFSTR(HSTEXT,"^")

                   SET HSTEXT=$$CTRL^BQIUL1(HSTEXT)

 +47               IF HSTEXT=""

                       SET HSTEXT=" "

 +48               SET BQII=BQII+1

                   SET @DATA@(BQII)=HSTEXT_$CHAR(13)_$CHAR(10)

               End DoDot:1

 +49       SET BQII=BQII+1

           SET @DATA@(BQII)=$CHAR(30)

 +50      ;

 +51       IF $$TMPFL^BQIUL1("C")

               GOTO DONE

 +52       IF $$TMPFL^BQIUL1("D",UID,DFN)

               GOTO DONE

 +53      ;

DONE      ;

 +1       ;

 +2        SET BQII=BQII+1

           SET @DATA@(BQII)=$CHAR(31)

 +3        QUIT 

 +4       ;

HDR       ;

 +1        SET @DATA@(BQII)="T02048REPORT_TEXT"_$CHAR(30)

 +2        QUIT 

 +3       ;

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(BQII)

               IF $DATA(DATA)

                   SET BQII=BQII+1

                   SET @DATA@(BQII)=$CHAR(31)

 +6        IF $$TMPFL^BQIUL1("C")

 +7        QUIT