BDMGRH.m

BDMGRH ; IHS/CMI/LAB - BDM DMS GUI Reports ; 09 Feb 2010  7:38 AM

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**9,10,11**;JUN 14, 2007;Build 30

 ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

 D DEBUG^%Serenji("DMA12P^BDMGRE(.BDMRET,.BDMSTR)")

 Q

 ;

DMA16(RETVAL,BDMSTR) ;-- dm audit 2016

 N P,R

 N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP,BDMPNA

 N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ

 N BDMDZ2,BDMDEMO,BDMBEN,BDMPREG,BDMBD

 S BDMH=$H,BDMJ=$J

 S P="|",R="~"

 S RETVAL="^BDMTMP("_$J_")"

 I $G(BDMSTR)="" D 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 BDMBD=($E(BDMDAT,1,3)-1)_$E(BDMDAT,4,7),BDMBD=$$FMADD^XLFDT(BDMBD,1)

 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 BDMPNA=$P(BDMSTR,P,15)

 S BDMDSP=$P(BDMSTR,P,16)

 S BDMSDPI=$P(BDMSTR,P,12)

 S BDMSDPIN=$P(BDMSTR,P,13)

 S BDMCALL=$P(BDMSTR,P,14)

 S BDMDZ2=$P(BDMSTR,P,17)

 S BDMDEMO=$P(BDMSTR,P,18)

 S BDMBEN=$P(BDMSTR,P,19)

 S BDMPREG=$P(BDMSTR,P,20)

 I BDMCALL="DM Audit E 16" 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("BDMDM16",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""

 .. I BDMCALL="DM Audit P 16" D

 ... S ^XTMP("BDMPD1",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,BDMCNT

 . S BDMCNT=0

 . 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 BDMCNT=BDMCNT+1

 .. I BDMBEN=1,$$BEN^AUPNPAT(BDMDA,"C")'="01" Q

 .. I BDMBEN=2,$$BEN^AUPNPAT(BDMDA,"C")="01" Q

 .. I BDMPREG="E" Q:$$PREG^BDMDD1B(BDMDA,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMDA)=""

 .. S ^TMP($J,"PATS",BDMCNT,BDMDA)=""

 .. I BDMCALL="DM Audit P 16" D

 ... S ^XTMP("BDMPD1",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,BDMCNT

 . S BDMCNT=0

 . 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

 .. I BDMBEN=1,$$BEN^AUPNPAT(BDMRPAT,"C")'="01" Q

 .. I BDMBEN=2,$$BEN^AUPNPAT(BDMRPAT,"C")="01" Q

 .. I BDMPREG="E" Q:$$PREG^BDMDD1B(BDMRPAT,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMRPAT)=""

 .. I BDMSTAT]"",$P($G(^ACM(41,BDMDA,"DT")),U,1)=BDMSTAT S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,BDMRPAT)=""

 .. I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,BDMRPAT)=""

 .. I BDMCALL="DM Audit P 16" D

 ... S ^XTMP("BDMPD1",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))=""

 .. I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))=""

 . K ^XTMP("BDMDM16",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("BDMDM16",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 2016" D

 . D BDMG^BDMDD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I BDMCALL="DM Audit P 16" D

 . D BDMG^BDMPD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I BDMCALL="DM Audit E 16" D

 . D BDMG^BDMDD1E(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,BDMDZ2,BDMDEMO)

 I $G(BDMDSP) S BDMIEN=1 D NOWDMO16 Q

 I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"

 I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)

 D EN^XBVK("BDM")

 Q

 ;

DMA16P(BDMRET,BDMSTR) ;-- dm audit 2016

 N P,R

 N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP,BDMPNA

 N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ

 N BDMDZ2,BDMDEMO,BDMBEN,BDMPREG,BDMBD

 S BDMH=$H,BDMJ=$J

 S P="|",R="~"

 S BDMRET="^BDMTMP("_$J_")"

 I $G(BDMSTR)="" D 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 BDMBD=($E(BDMDAT,1,3)-1)_$E(BDMDAT,4,7),BDMBD=$$FMADD^XLFDT(BDMBD,1)

 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 BDMPNA=$P(BDMSTR,P,15)

 S BDMDSP=$P(BDMSTR,P,16)

 S BDMSDPI=$P(BDMSTR,P,12)

 S BDMSDPIN=$P(BDMSTR,P,13)

 S BDMCALL=$P(BDMSTR,P,14)

 S BDMDZ2=$P(BDMSTR,P,17)

 S BDMDEMO=$P(BDMSTR,P,18)

 S BDMBEN=$P(BDMSTR,P,19)

 S BDMPREG=$P(BDMSTR,P,20)

 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("BDMDM16",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

 .. I BDMPREG="E" Q:$$PREG^BDMDD1B(BDMDA,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM16",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

 .. I BDMPREG="E" Q:$$PREG^BDMDD1B(BDMRPAT,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMRPAT)=""

 I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)

 D BDMG^BDMDD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I $G(BDMDSP) S BDMIEN=1 D NOWDMO16 Q

 I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"

 I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)

 Q

 ;

NOWDMO16 ;EP - return the output to the screen

 N BDMI,BDMDA

 S BDMI=0

 S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^TMP($J,"BDMDM16",BDMDA)) Q:'BDMDA  D

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDM16",BDMDA))_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)+$G(BDMERR)

 Q

 ;

DMA17(RETVAL,BDMSTR) ;-- dm audit 2017

 N P,R

 N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP,BDMPNA

 N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ

 N BDMDZ2,BDMDEMO,BDMBEN,BDMPREG,BDMBD

 S BDMH=$H,BDMJ=$J

 S P="|",R="~"

 S RETVAL="^BDMTMP("_$J_")"

 I $G(BDMSTR)="" D 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 BDMBD=($E(BDMDAT,1,3)-1)_$E(BDMDAT,4,7),BDMBD=$$FMADD^XLFDT(BDMBD,1)

 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 BDMPNA=$P(BDMSTR,P,15)

 S BDMDSP=$P(BDMSTR,P,16)

 S BDMSDPI=$P(BDMSTR,P,12)

 S BDMSDPIN=$P(BDMSTR,P,13)

 S BDMCALL=$P(BDMSTR,P,14)

 S BDMDZ2=$P(BDMSTR,P,17)

 S BDMDEMO=$P(BDMSTR,P,18)

 S BDMBEN=$P(BDMSTR,P,19)

 S BDMPREG=$P(BDMSTR,P,20)

 I BDMCALL="DM Audit E 17" 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("BDMDM17",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""

 .. I BDMCALL="DM Audit P 17" D

 ... S ^XTMP("BDMPD1",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,BDMCNT

 . S BDMCNT=0

 . 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 BDMCNT=BDMCNT+1

 .. I BDMBEN=1,$$BEN^AUPNPAT(BDMDA,"C")'="01" Q

 .. I BDMBEN=2,$$BEN^AUPNPAT(BDMDA,"C")="01" Q

 .. I BDMPREG="E" Q:$$PREG^BDMDE1B(BDMDA,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMDA)=""

 .. S ^TMP($J,"PATS",BDMCNT,BDMDA)=""

 .. I BDMCALL="DM Audit P 17" D

 ... S ^XTMP("BDMPE1",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,BDMCNT

 . S BDMCNT=0

 . 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

 .. I BDMBEN=1,$$BEN^AUPNPAT(BDMRPAT,"C")'="01" Q

 .. I BDMBEN=2,$$BEN^AUPNPAT(BDMRPAT,"C")="01" Q

 .. I BDMPREG="E" Q:$$PREG^BDMDE1B(BDMRPAT,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMRPAT)=""

 .. I BDMSTAT]"",$P($G(^ACM(41,BDMDA,"DT")),U,1)=BDMSTAT S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,BDMRPAT)=""

 .. I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,BDMRPAT)=""

 .. I BDMCALL="DM Audit P 17" D

 ... S ^XTMP("BDMPE1",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))=""

 .. I BDMSTAT="" S BDMCNT=BDMCNT+1,^TMP($J,"PATS",BDMCNT,$P(^ACM(41,X,0),U,2))=""

 . K ^XTMP("BDMDM17",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("BDMDM17",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 2017" D

 . D BDMG^BDMDE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I BDMCALL="DM Audit P 17" D

 . D BDMG^BDMPE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I BDMCALL="DM Audit E 17" D

 . D BDMG^BDMDE1E(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,BDMDZ2,BDMDEMO)

 I $G(BDMDSP) S BDMIEN=1 D NOWDMO17 Q

 I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"

 I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)

 D EN^XBVK("BDM")

 Q

 ;

DMA17P(BDMRET,BDMSTR) ;-- dm audit 2017

 N P,R

 N BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP,BDMPNA

 N BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ

 N BDMDZ2,BDMDEMO,BDMBEN,BDMPREG,BDMBD

 S BDMH=$H,BDMJ=$J

 S P="|",R="~"

 S BDMRET="^BDMTMP("_$J_")"

 I $G(BDMSTR)="" D 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 BDMBD=($E(BDMDAT,1,3)-1)_$E(BDMDAT,4,7),BDMBD=$$FMADD^XLFDT(BDMBD,1)

 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 BDMPNA=$P(BDMSTR,P,15)

 S BDMDSP=$P(BDMSTR,P,16)

 S BDMSDPI=$P(BDMSTR,P,12)

 S BDMSDPIN=$P(BDMSTR,P,13)

 S BDMCALL=$P(BDMSTR,P,14)

 S BDMDZ2=$P(BDMSTR,P,17)

 S BDMDEMO=$P(BDMSTR,P,18)

 S BDMBEN=$P(BDMSTR,P,19)

 S BDMPREG=$P(BDMSTR,P,20)

 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("BDMDM17",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

 .. I BDMPREG="E" Q:$$PREG^BDMDE1B(BDMDA,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM17",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

 .. I BDMPREG="E" Q:$$PREG^BDMDE1B(BDMRPAT,BDMBD,BDMDAT,1,1)

 .. S ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMRPAT)=""

 I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)

 D BDMG^BDMDE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)

 I $G(BDMDSP) S BDMIEN=1 D NOWDMO17 Q

 I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"

 I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)

 Q

 ;

NOWDMO17 ;EP - return the output to the screen

 N BDMI,BDMDA

 S BDMI=0

 S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)

 S BDMDA=0 F  S BDMDA=$O(^TMP($J,"BDMDM17",BDMDA)) Q:'BDMDA  D

 . S BDMI=BDMI+1

 . S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDM17",BDMDA))_$C(30)

 S ^BDMTMP($J,BDMI+1)=$C(31)+$G(BDMERR)

 Q

 ;

BDMGRH    ; IHS/CMI/LAB - BDM DMS GUI Reports ; 09 Feb 2010  7:38 AM

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**9,10,11**;JUN 14, 2007;Build 30

 +2       ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

 +1        DO DEBUG^%Serenji("DMA12P^BDMGRE(.BDMRET,.BDMSTR)")

 +2        QUIT 

 +3       ;

DMA16(RETVAL,BDMSTR) ;-- dm audit 2016

 +1        NEW P,R

 +2        NEW BDMRG,BDMDAT,BDMTYP,BDMSTMP,BDMPCP,BDMLCOM,BDMRAND,BDMRCNT,BDMDSP,BDMPNA

 +3        NEW BDMCMS,BDMRGI,BDMSTAT,BDMPREP,BDMFILE,BDMPATS,BDMSTMPE,BDMCMSE,BDMH,BDMJ

 +4        NEW BDMDZ2,BDMDEMO,BDMBEN,BDMPREG,BDMBD

 +5        SET BDMH=$HOROLOG

           SET BDMJ=$JOB

 +6        SET P="|"

           SET R="~"

 +7        SET RETVAL="^BDMTMP("_$JOB_")"

 +8        IF $GET(BDMSTR)=""

               DO CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 +9        SET BDMRGI=$PIECE(BDMSTR,P)

 +10       SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))

 +11       SET BDMDAT=$PIECE(BDMSTR,P,2)

 +12       SET BDMBD=($EXTRACT(BDMDAT,1,3)-1)_$EXTRACT(BDMDAT,4,7)

           SET BDMBD=$$FMADD^XLFDT(BDMBD,1)

 +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 BDMPNA=$PIECE(BDMSTR,P,15)

 +22       SET BDMDSP=$PIECE(BDMSTR,P,16)

 +23       SET BDMSDPI=$PIECE(BDMSTR,P,12)

 +24       SET BDMSDPIN=$PIECE(BDMSTR,P,13)

 +25       SET BDMCALL=$PIECE(BDMSTR,P,14)

 +26       SET BDMDZ2=$PIECE(BDMSTR,P,17)

 +27       SET BDMDEMO=$PIECE(BDMSTR,P,18)

 +28       SET BDMBEN=$PIECE(BDMSTR,P,19)

 +29       SET BDMPREG=$PIECE(BDMSTR,P,20)

 +30       IF BDMCALL="DM Audit E 16"

               Begin DoDot:1

 +31               SET BDMTYP=""

               End DoDot:1

 +32       IF BDMTYP="P"

               Begin DoDot:1

 +33               SET BDMPATS=$PIECE(BDMSTR,P,4)

 +34               NEW I

 +35               FOR I=1:1

                       Begin DoDot:2

 +36                       IF $PIECE(BDMPATS,R,I)=""

                               QUIT 

 +37                       SET ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""

 +38                       IF BDMCALL="DM Audit P 16"

                               Begin DoDot:3

 +39                               SET ^XTMP("BDMPD1",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""

                               End DoDot:3

                       End DoDot:2

                       IF $PIECE(BDMPATS,R,I)=""

                           QUIT 

               End DoDot:1

 +40       IF BDMTYP="S"

               Begin DoDot:1

 +41               SET BDMSTMPE=$PIECE(BDMSTR,P,4)

 +42               SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))

 +43               IF 'BDMSTMP

                       QUIT 

 +44               NEW BDMDA,BDMCNT

 +45               SET BDMCNT=0

 +46               SET BDMDA=0

                   FOR 

                       SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))

                       IF 'BDMDA

                           QUIT 

                       Begin DoDot:2

 +47                       IF $GET(BDMCOM)

                               IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM

                                   QUIT 

 +48                       IF $GET(BDMPCP)

                               IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP