BDMGRB ; IHS/CMI/LAB - BDM DMS GUI Reports ;
;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1**;JUN 14, 2007
;
;
;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
;
DEBUG(BDMRET,BDMSTR) ;-- debugger
D DEBUG^%Serenji("DMA7^BDMGRB(.BDMRET,.BDMSTR)")
Q
;
DMA6(BDMRET,BDMSTR) ;-- dm audit 2006
N P,R
N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
S BDMH=$H,BDMJ=$J
S P="|",R="~"
S BDMRET="^BDMTMP("_$J_")"
I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
S BDMRGI=$P(BDMSTR,P)
S BDMRG=$O(^ACM(41.1,"B",BDMRGI,0))
S BDMDAT=$P(BDMSTR,P,2)
S BDMTYP=$P(BDMSTR,P,3)
S BDMPCP=$P(BDMSTR,P,5)
S BDMCOM=$P(BDMSTR,P,6)
S BDMRAND=$P(BDMSTR,P,7)
S BDMRCNT=$P(BDMSTR,P,8)
S BDMSTAT=$P(BDMSTR,P,9)
S BDMPREP=$P(BDMSTR,P,10)
S BDMFILE=$P(BDMSTR,P,11)
S BDMDSP=$P(BDMSTR,P,15)
S BDMSDPI=$P(BDMSTR,P,12)
S BDMSDPIN=$P(BDMSTR,P,13)
S BDMCALL=$P(BDMSTR,P,14)
I BDMCALL="DM Audit E 06" D
. S BDMTYP=""
I BDMTYP="P" D
. S BDMPATS=$P(BDMSTR,P,4)
. N I
. F I=1:1 D Q:$P(BDMPATS,R,I)=""
.. Q:$P(BDMPATS,R,I)=""
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
.. I BDMCALL="DM Audit P 06" D
... S ^XTMP("BDMP61",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
I BDMTYP="S" D
. S BDMSTMPE=$P(BDMSTR,P,4)
. S BDMSTMP=$O(^DIBT("B",BDMSTMPE,0))
. Q:'BDMSTMP
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^DIBT(BDMSTMP,1,BDMDA)) Q:'BDMDA D
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
.. I BDMCALL="DM Audit P 06" D
... S ^XTMP("BDMP61",BDMJ,BDMH,"PATS",BDMDA)=""
I BDMTYP="C" D
. S BDMCMSE=$P(BDMSTR,P,4)
. Q:$G(BDMCMSE)=""
. S BDMCMS=$O(^ACM(41.1,"B",BDMCMSE,0))
. Q:'BDMCMS
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^ACM(41,"B",BDMCMS,BDMDA)) Q:'BDMDA D
.. S BDMRPAT=$P($G(^ACM(41,BDMDA,0)),U,2)
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
.. I $G(BDMSTAT)]"" Q:$P($G(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
.. I BDMCALL="DM Audit P 06" D
... S ^XTMP("BDMP61",BDMJ,BDMH,"PATS",BDMRPAT)=""
I BDMRAND="Y" D
. N X
. K ^TMP($J,"PATS") S BDMCNT=0,X=0 F S X=$O(^ACM(41,"B",BDMRG,X)) Q:X'=+X D
.. I BDMSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMSTAT S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))="" Q
.. I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))=""
. K ^XTMP("BDMDM61",BDMJ,BDMH,"PATS")
. S (X,BDMCNT)=0 F S X=$O(^TMP($J,"PATS",X)) Q:X'=+X S BDMCNT=BDMCNT+1
. S C=0 F N=1:1:BDMCNT Q:C=BDMRCNT S I=$R(BDMCNT) I I,$D(^TMP($J,"PATS",I)) S X=$O(^TMP($J,"PATS",I,0)),^XTMP("BDMDM61",BDMJ,BDMH,"PATS",X)="",C=C+1 K ^TMP($J,"PATS",I,X)
. K ^TMP($J,"PATS")
I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)
I BDMCALL="DM Audit 2006" D
. D BDMG^BDMD61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$G(BDMSTMP),BDMPCP,BDMCOM,$G(BDMRAND),$G(BDMRCNT),$G(BDMCMS),$G(BDMSTAT),BDMPREP,$G(BDMFILE),$G(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
I BDMCALL="DM Audit P 06" D
. D BDMG^BDMP61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$G(BDMSTMP),BDMPCP,BDMCOM,$G(BDMRAND),$G(BDMRCNT),$G(BDMCMS),$G(BDMSTAT),BDMPREP,$G(BDMFILE),$G(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
I BDMCALL="DM Audit E 06" D
. D BDMG^BDMD61E(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$G(BDMSTMP),BDMPCP,BDMCOM,$G(BDMRAND),$G(BDMRCNT),$G(BDMCMS),$G(BDMSTAT),BDMPREP,$G(BDMFILE),$G(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
I $G(BDMDSP) S BDMIEN=1 D NOWDMO^BDMGRA Q
I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
Q
;
DMA6P(BDMRET,BDMSTR) ;-- dm audit 2006
N P,R
N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
S BDMH=$H,BDMJ=$J
S P="|",R="~"
S BDMRET="^BDMTMP("_$J_")"
I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
S BDMRGI=$P(BDMSTR,P)
S BDMRG=$O(^ACM(41.1,"B",BDMRGI,0))
S BDMRGI=$P(BDMSTR,P)
S BDMRG=$O(^ACM(41.1,"B",BDMRGI,0))
S BDMDAT=$P(BDMSTR,P,2)
S BDMTYP=$P(BDMSTR,P,3)
S BDMPCP=$P(BDMSTR,P,5)
S BDMCOM=$P(BDMSTR,P,6)
S BDMRAND=$P(BDMSTR,P,7)
S BDMRCNT=$P(BDMSTR,P,8)
S BDMSTAT=$P(BDMSTR,P,9)
S BDMPREP=$P(BDMSTR,P,10)
S BDMFILE=$P(BDMSTR,P,11)
S BDMDSP=$P(BDMSTR,P,16)
S BDMSDPI=$P(BDMSTR,P,12)
S BDMSDPIN=$P(BDMSTR,P,13)
S BDMCALL=$P(BDMSTR,P,14)
I BDMTYP="P" D
. S BDMPATS=$P(BDMSTR,P,4)
. N I
. F I=1:1 D Q:$P(BDMPATS,R,I)=""
.. Q:$P(BDMPATS,R,I)=""
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
I BDMTYP="S" D
. S BDMSTMPE=$P(BDMSTR,P,4)
. S BDMSTMP=$O(^DIBT("B",BDMSTMPE,0))
. Q:'BDMSTMP
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^DIBT(BDMSTMP,1,BDMDA)) Q:'BDMDA D
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
I BDMTYP="C" D
. S BDMCMSE=$P(BDMSTR,P,4)
. S BDMCMS=$O(^ACM(41.1,"B",BDMCMSE,0))
. Q:'BDMCMS
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^ACM(41,"B",BDMCMS,BDMDA)) Q:'BDMDA D
.. S BDMRPAT=$P($G(^ACM(41,BDMDA,0)),U,2)
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
.. I $G(BDMSTAT)]"" Q:$P($G(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)
D BDMG^BDMD61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$G(BDMSTMP),BDMPCP,BDMCOM,$G(BDMRAND),$G(BDMRCNT),$G(BDMCMS),$G(BDMSTAT),BDMPREP,$G(BDMFILE),$G(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
I $G(BDMDSP) S BDMIEN=1 D NOWDMO6^BDMGRA Q
I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
Q
;
DMA6E(BDMRET,BDMSTR) ;-- dm audit 2006
N P,R
N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
S BDMH=$H,BDMJ=$J
S P="|",R="~"
S BDMRET="^BDMTMP("_$J_")"
I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
S BDMRGI=$P(BDMSTR,P)
S BDMRG=$O(^ACM(41.1,"B",BDMRGI,0))
S BDMDAT=$P(BDMSTR,P,2)
S BDMTYP=$P(BDMSTR,P,3)
S BDMPCP=$P(BDMSTR,P,5)
S BDMCOM=$P(BDMSTR,P,6)
S BDMRAND=$P(BDMSTR,P,7)
S BDMRCNT=$P(BDMSTR,P,8)
S BDMSTAT=$P(BDMSTR,P,9)
S BDMPREP=$P(BDMSTR,P,10)
S BDMFILE=$P(BDMSTR,P,11)
S BDMDSP=$P(BDMSTR,P,14)
S BDMSDPI=$P(BDMSTR,P,12)
S BDMSDPIN=$P(BDMSTR,P,13)
I BDMTYP="P" D
. S BDMPATS=$P(BDMSTR,P,4)
. N I
. F I=1:1 D Q:$P(BDMPATS,R,I)=""
.. Q:$P(BDMPATS,R,I)=""
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
I BDMTYP="S" D
. S BDMSTMPE=$P(BDMSTR,P,4)
. S BDMSTMP=$O(^DIBT("B",BDMSTMPE,0))
. Q:'BDMSTMP
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^DIBT(BDMSTMP,1,BDMDA)) Q:'BDMDA D
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
I BDMTYP="C" D
. S BDMCMSE=$P(BDMSTR,P,4)
. S BDMCMS=$O(^ACM(41.1,"B",BDMCMSE,0))
. Q:'BDMCMS
. N BDMDA
. S BDMDA=0 F S BDMDA=$O(^ACM(41,"B",BDMCMS,BDMDA)) Q:'BDMDA D
.. S BDMRPAT=$P($G(^ACM(41,BDMDA,0)),U,2)
.. I $G(BDMCOM) Q:$P($G(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
.. I $G(BDMPCP) Q:$P($G(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
.. I $G(BDMSTAT)]"" Q:$P($G(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
.. S ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)
D BDMG^BDMD51(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$G(BDMSTMP),BDMPCP,BDMCOM,$G(BDMRAND),$G(BDMRCNT),$G(BDMCMS),$G(BDMSTAT),BDMPREP,$G(BDMFILE),$G(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
I $G(BDMDSP) S BDMIEN=1 D NOWDMO^BDMGRA Q
I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
Q
;
PLDX(BDMRET,BDMSTR) ;-- return the DM PTS with no Dx
N P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMRTYP=$P(BDMSTR,P)
S BDMREGE=$P(BDMSTR,P,2)
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMSTAT=$P(BDMSTR,P,3)
S BDMNDX=$P(BDMSTR,P,4)
S BDMDAT=$P(BDMSTR,P,5)
D BDMG^BDMDR1(BDMRTYP,$G(BDMREG),BDMSTAT,BDMNDX,BDMDAT)
;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR1",BDMDA)) Q:'BDMDA D
;. S BDMI=BDMI+1
;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR1",BDMDA))_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
NDOO(BDMRET,BDMSTR) ;-- return the DM PTS with no Date of Onset
N P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMRTYP=$P(BDMSTR,P)
S BDMREGE=$P(BDMSTR,P,2)
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
S BDMSTAT=$P(BDMSTR,P,3)
D BDMG^BDMDR2(BDMRTYP,$G(BDMREG),BDMSTAT)
;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR2",BDMDA)) Q:'BDMDA D
;. S BDMI=BDMI+1
;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR2",BDMDA))_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
APCL(BDMRET,BDMSTR) ;-- return DM Patients with an Appointment
N P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA,R
S P="|",R="~"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMREGE=$P(BDMSTR,P)
S BDMBD=$P(BDMSTR,P,2)
S BDMED=$P(BDMSTR,P,3)
S BDMCLN=$P(BDMSTR,P,4)
I BDMCLN'="A" D
. F I=1:1 D Q:'$P(BDMCLN,R,I)
.. Q:'$P(BDMCLN,R,I)
.. S BDMCLNI=$P(BDMCLN,R,I)
.. S BDMCLNE(BDMCLNI)=""
I BDMCLN="A" K BDMCLN
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
D BDMG^BDMDMAP($G(BDMREG),BDMBD,BDMED,.BDMCLNE)
;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDMAP",BDMDA)) Q:'BDMDA D
;. S BDMI=BDMI+1
;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDMAP",BDMDA))_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
DMV(BDMRET,BDMSTR) ;-- return DM Patients with an Appointment
N P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMSTAR,BDMDAT,BDMDA
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMREGE=$P(BDMSTR,P)
S BDMSTAT=$P(BDMSTR,P,2)
S BDMPCP=$P(BDMSTR,P,4)
S BDMED=$P(BDMSTR,P,3)
S BDMSTAR=$P(BDMSTR,P,5)
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
D BDMG^BDMDR3($G(BDMREG),BDMSTAT,BDMPCP,BDMED,BDMSTAR)
;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR3",BDMDA)) Q:'BDMDA D
;. S BDMI=BDMI+1
;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR3",BDMDA))_$C(30)
S ^BDMTMP($J,BDMI+1)=$C(31)_$G(BDMERR)
Q
;
HSRG(BDMRET,BDMSTR) ;-- return DM Patients with a Health Summary
N P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMDATE,BDMTYPE,BDMDA
S P="|"
K ^BDMTMP($J)
S BDMRET="^BDMTMP("_$J_")"
S BDMI=0
S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
S BDMREGE=$P(BDMSTR,P)
S BDMDATE=$P(BDMSTR,P,2)
S BDMTYPE=$P(BDMSTR,P,3)
I $G(BDMREGE)]"" S BDMREG=$O(^ACM(41.1,"B",BDMREGE,0))
D BDMG^BDMDMAS($G(BDMREG),BDMDATE,BDMTYPE,.BDMIEN)
I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
Q
;
BDMGRB ; IHS/CMI/LAB - BDM DMS GUI Reports ;
+1 ;;2.0;BDM DIABETES MANAGEMENT SYSTEM;**1**;JUN 14, 2007
+2 ;
+3 ;
+4 ;cmi/anch/maw 1/25/2005 added line in FUR for uppercase dx type
+5 ;
DEBUG(BDMRET,BDMSTR) ;-- debugger
+1 DO DEBUG^%Serenji("DMA7^BDMGRB(.BDMRET,.BDMSTR)")
+2 QUIT
+3 ;
DMA6(BDMRET,BDMSTR) ;-- dm audit 2006
+1 NEW P,R
+2 NEW BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
+3 NEW BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
+4 SET BDMH=$HOROLOG
SET BDMJ=$JOB
+5 SET P="|"
SET R="~"
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 IF $GET(BDMSTR)=""
SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
+8 SET BDMRGI=$PIECE(BDMSTR,P)
+9 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+10 SET BDMDAT=$PIECE(BDMSTR,P,2)
+11 SET BDMTYP=$PIECE(BDMSTR,P,3)
+12 SET BDMPCP=$PIECE(BDMSTR,P,5)
+13 SET BDMCOM=$PIECE(BDMSTR,P,6)
+14 SET BDMRAND=$PIECE(BDMSTR,P,7)
+15 SET BDMRCNT=$PIECE(BDMSTR,P,8)
+16 SET BDMSTAT=$PIECE(BDMSTR,P,9)
+17 SET BDMPREP=$PIECE(BDMSTR,P,10)
+18 SET BDMFILE=$PIECE(BDMSTR,P,11)
+19 SET BDMDSP=$PIECE(BDMSTR,P,15)
+20 SET BDMSDPI=$PIECE(BDMSTR,P,12)
+21 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
+22 SET BDMCALL=$PIECE(BDMSTR,P,14)
+23 IF BDMCALL="DM Audit E 06"
Begin DoDot:1
+24 SET BDMTYP=""
End DoDot:1
+25 IF BDMTYP="P"
Begin DoDot:1
+26 SET BDMPATS=$PIECE(BDMSTR,P,4)
+27 NEW I
+28 FOR I=1:1
Begin DoDot:2
+29 IF $PIECE(BDMPATS,R,I)=""
QUIT
+30 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
+31 IF BDMCALL="DM Audit P 06"
Begin DoDot:3
+32 SET ^XTMP("BDMP61",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
End DoDot:3
End DoDot:2
IF $PIECE(BDMPATS,R,I)=""
QUIT
End DoDot:1
+33 IF BDMTYP="S"
Begin DoDot:1
+34 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
+35 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
+36 IF 'BDMSTMP
QUIT
+37 NEW BDMDA
+38 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+39 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
QUIT
+40 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
QUIT
+41 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
+42 IF BDMCALL="DM Audit P 06"
Begin DoDot:3
+43 SET ^XTMP("BDMP61",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+44 IF BDMTYP="C"
Begin DoDot:1
+45 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+46 IF $GET(BDMCMSE)=""
QUIT
+47 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+48 IF 'BDMCMS
QUIT
+49 NEW BDMDA
+50 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+51 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+52 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+53 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+54 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+55 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
+56 IF BDMCALL="DM Audit P 06"
Begin DoDot:3
+57 SET ^XTMP("BDMP61",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+58 IF BDMRAND="Y"
Begin DoDot:1
+59 NEW X
+60 KILL ^TMP($JOB,"PATS")
SET BDMCNT=0
SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",BDMRG,X))
IF X'=+X
QUIT
Begin DoDot:2
+61 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=BDMSTAT
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
QUIT
+62 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
End DoDot:2
+63 KILL ^XTMP("BDMDM61",BDMJ,BDMH,"PATS")
+64 SET (X,BDMCNT)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET BDMCNT=BDMCNT+1
+65 SET C=0
FOR N=1:1:BDMCNT
IF C=BDMRCNT
QUIT
SET I=$RANDOM(BDMCNT)
IF I
IF $DATA(^TMP($JOB,"PATS",I))
SET X=$ORDER(^TMP($JOB,"PATS",I,0))
SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",X)=""
SET C=C+1
KILL ^TMP($JOB,"PATS",I,X)
+66 KILL ^TMP($JOB,"PATS")
End DoDot:1
+67 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+68 IF BDMCALL="DM Audit 2006"
Begin DoDot:1
+69 DO BDMG^BDMD61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$GET(BDMSTMP),BDMPCP,BDMCOM,$GET(BDMRAND),$GET(BDMRCNT),$GET(BDMCMS),$GET(BDMSTAT),BDMPREP,$GET(BDMFILE),$GET(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
End DoDot:1
+70 IF BDMCALL="DM Audit P 06"
Begin DoDot:1
+71 DO BDMG^BDMP61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$GET(BDMSTMP),BDMPCP,BDMCOM,$GET(BDMRAND),$GET(BDMRCNT),$GET(BDMCMS),$GET(BDMSTAT),BDMPREP,$GET(BDMFILE),$GET(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
End DoDot:1
+72 IF BDMCALL="DM Audit E 06"
Begin DoDot:1
+73 DO BDMG^BDMD61E(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$GET(BDMSTMP),BDMPCP,BDMCOM,$GET(BDMRAND),$GET(BDMRCNT),$GET(BDMCMS),$GET(BDMSTAT),BDMPREP,$GET(BDMFILE),$GET(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
End DoDot:1
+74 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO^BDMGRA
QUIT
+75 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+76 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+77 QUIT
+78 ;
DMA6P(BDMRET,BDMSTR) ;-- dm audit 2006
+1 NEW P,R
+2 NEW BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
+3 NEW BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
+4 SET BDMH=$HOROLOG
SET BDMJ=$JOB
+5 SET P="|"
SET R="~"
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 IF $GET(BDMSTR)=""
SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
+8 SET BDMRGI=$PIECE(BDMSTR,P)
+9 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+10 SET BDMRGI=$PIECE(BDMSTR,P)
+11 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+12 SET BDMDAT=$PIECE(BDMSTR,P,2)
+13 SET BDMTYP=$PIECE(BDMSTR,P,3)
+14 SET BDMPCP=$PIECE(BDMSTR,P,5)
+15 SET BDMCOM=$PIECE(BDMSTR,P,6)
+16 SET BDMRAND=$PIECE(BDMSTR,P,7)
+17 SET BDMRCNT=$PIECE(BDMSTR,P,8)
+18 SET BDMSTAT=$PIECE(BDMSTR,P,9)
+19 SET BDMPREP=$PIECE(BDMSTR,P,10)
+20 SET BDMFILE=$PIECE(BDMSTR,P,11)
+21 SET BDMDSP=$PIECE(BDMSTR,P,16)
+22 SET BDMSDPI=$PIECE(BDMSTR,P,12)
+23 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
+24 SET BDMCALL=$PIECE(BDMSTR,P,14)
+25 IF BDMTYP="P"
Begin DoDot:1
+26 SET BDMPATS=$PIECE(BDMSTR,P,4)
+27 NEW I
+28 FOR I=1:1
Begin DoDot:2
+29 IF $PIECE(BDMPATS,R,I)=""
QUIT
+30 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
End DoDot:2
IF $PIECE(BDMPATS,R,I)=""
QUIT
End DoDot:1
+31 IF BDMTYP="S"
Begin DoDot:1
+32 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
+33 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
+34 IF 'BDMSTMP
QUIT
+35 NEW BDMDA
+36 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+37 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
QUIT
+38 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
QUIT
+39 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:2
End DoDot:1
+40 IF BDMTYP="C"
Begin DoDot:1
+41 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+42 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+43 IF 'BDMCMS
QUIT
+44 NEW BDMDA
+45 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+46 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+47 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+48 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+49 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+50 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:2
End DoDot:1
+51 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+52 DO BDMG^BDMD61(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$GET(BDMSTMP),BDMPCP,BDMCOM,$GET(BDMRAND),$GET(BDMRCNT),$GET(BDMCMS),$GET(BDMSTAT),BDMPREP,$GET(BDMFILE),$GET(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
+53 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO6^BDMGRA
QUIT
+54 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+55 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+56 QUIT
+57 ;
DMA6E(BDMRET,BDMSTR) ;-- dm audit 2006
+1 NEW P,R
+2 NEW BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP
+3 NEW BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ
+4 SET BDMH=$HOROLOG
SET BDMJ=$JOB
+5 SET P="|"
SET R="~"
+6 SET BDMRET="^BDMTMP("_$JOB_")"
+7 IF $GET(BDMSTR)=""
SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)
+8 SET BDMRGI=$PIECE(BDMSTR,P)
+9 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+10 SET BDMDAT=$PIECE(BDMSTR,P,2)
+11 SET BDMTYP=$PIECE(BDMSTR,P,3)
+12 SET BDMPCP=$PIECE(BDMSTR,P,5)
+13 SET BDMCOM=$PIECE(BDMSTR,P,6)
+14 SET BDMRAND=$PIECE(BDMSTR,P,7)
+15 SET BDMRCNT=$PIECE(BDMSTR,P,8)
+16 SET BDMSTAT=$PIECE(BDMSTR,P,9)
+17 SET BDMPREP=$PIECE(BDMSTR,P,10)
+18 SET BDMFILE=$PIECE(BDMSTR,P,11)
+19 SET BDMDSP=$PIECE(BDMSTR,P,14)
+20 SET BDMSDPI=$PIECE(BDMSTR,P,12)
+21 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
+22 IF BDMTYP="P"
Begin DoDot:1
+23 SET BDMPATS=$PIECE(BDMSTR,P,4)
+24 NEW I
+25 FOR I=1:1
Begin DoDot:2
+26 IF $PIECE(BDMPATS,R,I)=""
QUIT
+27 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
End DoDot:2
IF $PIECE(BDMPATS,R,I)=""
QUIT
End DoDot:1
+28 IF BDMTYP="S"
Begin DoDot:1
+29 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
+30 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
+31 IF 'BDMSTMP
QUIT
+32 NEW BDMDA
+33 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+34 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
QUIT
+35 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
QUIT
+36 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:2
End DoDot:1
+37 IF BDMTYP="C"
Begin DoDot:1
+38 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+39 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+40 IF 'BDMCMS
QUIT
+41 NEW BDMDA
+42 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+43 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+44 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+45 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+46 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+47 SET ^XTMP("BDMDM61",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:2
End DoDot:1
+48 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+49 DO BDMG^BDMD51(BDMJ,BDMH,BDMRG,BDMDAT,BDMTYP,$GET(BDMSTMP),BDMPCP,BDMCOM,$GET(BDMRAND),$GET(BDMRCNT),$GET(BDMCMS),$GET(BDMSTAT),BDMPREP,$GET(BDMFILE),$GET(BDMDSP),.BDMIEN,BDMSDPI,BDMSDPIN)
+50 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO^BDMGRA
QUIT
+51 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+52 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+53 QUIT
+54 ;
PLDX(BDMRET,BDMSTR) ;-- return the DM PTS with no Dx
+1 NEW P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA
+2 SET P="|"
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET BDMRTYP=$PIECE(BDMSTR,P)
+8 SET BDMREGE=$PIECE(BDMSTR,P,2)
+9 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+10 SET BDMSTAT=$PIECE(BDMSTR,P,3)
+11 SET BDMNDX=$PIECE(BDMSTR,P,4)
+12 SET BDMDAT=$PIECE(BDMSTR,P,5)
+13 DO BDMG^BDMDR1(BDMRTYP,$GET(BDMREG),BDMSTAT,BDMNDX,BDMDAT)
+14 ;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR1",BDMDA)) Q:'BDMDA D
+15 ;. S BDMI=BDMI+1
+16 ;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR1",BDMDA))_$C(30)
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
NDOO(BDMRET,BDMSTR) ;-- return the DM PTS with no Date of Onset
+1 NEW P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA
+2 SET P="|"
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET BDMRTYP=$PIECE(BDMSTR,P)
+8 SET BDMREGE=$PIECE(BDMSTR,P,2)
+9 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+10 SET BDMSTAT=$PIECE(BDMSTR,P,3)
+11 DO BDMG^BDMDR2(BDMRTYP,$GET(BDMREG),BDMSTAT)
+12 ;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR2",BDMDA)) Q:'BDMDA D
+13 ;. S BDMI=BDMI+1
+14 ;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR2",BDMDA))_$C(30)
+15 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+16 QUIT
+17 ;
APCL(BDMRET,BDMSTR) ;-- return DM Patients with an Appointment
+1 NEW P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMNDX,BDMDAT,BDMDA,R
+2 SET P="|"
SET R="~"
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET BDMREGE=$PIECE(BDMSTR,P)
+8 SET BDMBD=$PIECE(BDMSTR,P,2)
+9 SET BDMED=$PIECE(BDMSTR,P,3)
+10 SET BDMCLN=$PIECE(BDMSTR,P,4)
+11 IF BDMCLN'="A"
Begin DoDot:1
+12 FOR I=1:1
Begin DoDot:2
+13 IF '$PIECE(BDMCLN,R,I)
QUIT
+14 SET BDMCLNI=$PIECE(BDMCLN,R,I)
+15 SET BDMCLNE(BDMCLNI)=""
End DoDot:2
IF '$PIECE(BDMCLN,R,I)
QUIT
End DoDot:1
+16 IF BDMCLN="A"
KILL BDMCLN
+17 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+18 DO BDMG^BDMDMAP($GET(BDMREG),BDMBD,BDMED,.BDMCLNE)
+19 ;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDMAP",BDMDA)) Q:'BDMDA D
+20 ;. S BDMI=BDMI+1
+21 ;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDMAP",BDMDA))_$C(30)
+22 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+23 QUIT
+24 ;
DMV(BDMRET,BDMSTR) ;-- return DM Patients with an Appointment
+1 NEW P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMSTAT,BDMSTAR,BDMDAT,BDMDA
+2 SET P="|"
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET BDMREGE=$PIECE(BDMSTR,P)
+8 SET BDMSTAT=$PIECE(BDMSTR,P,2)
+9 SET BDMPCP=$PIECE(BDMSTR,P,4)
+10 SET BDMED=$PIECE(BDMSTR,P,3)
+11 SET BDMSTAR=$PIECE(BDMSTR,P,5)
+12 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+13 DO BDMG^BDMDR3($GET(BDMREG),BDMSTAT,BDMPCP,BDMED,BDMSTAR)
+14 ;S BDMDA=0 F S BDMDA=$O(^TMP($J,"BDMDR3",BDMDA)) Q:'BDMDA D
+15 ;. S BDMI=BDMI+1
+16 ;. S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDR3",BDMDA))_$C(30)
+17 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)_$GET(BDMERR)
+18 QUIT
+19 ;
HSRG(BDMRET,BDMSTR) ;-- return DM Patients with a Health Summary
+1 NEW P,BDMI,BDMRTYP,BDMREG,BDMREGE,BDMDATE,BDMTYPE,BDMDA
+2 SET P="|"
+3 KILL ^BDMTMP($JOB)
+4 SET BDMRET="^BDMTMP("_$JOB_")"
+5 SET BDMI=0
+6 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+7 SET BDMREGE=$PIECE(BDMSTR,P)
+8 SET BDMDATE=$PIECE(BDMSTR,P,2)
+9 SET BDMTYPE=$PIECE(BDMSTR,P,3)
+10 IF $GET(BDMREGE)]""
SET BDMREG=$ORDER(^ACM(41.1,"B",BDMREGE,0))
+11 DO BDMG^BDMDMAS($GET(BDMREG),BDMDATE,BDMTYPE,.BDMIEN)
+12 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+13 SET ^BDMTMP($JOB,1)=$CHAR(31)_$GET(BDMERR)
+14 QUIT
+15 ;
