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