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
QUIT
+49 SET BDMCNT=BDMCNT+1
+50 IF BDMBEN=1
IF $$BEN^AUPNPAT(BDMDA,"C")'="01"
QUIT
+51 IF BDMBEN=2
IF $$BEN^AUPNPAT(BDMDA,"C")="01"
QUIT
+52 IF BDMPREG="E"
IF $$PREG^BDMDD1B(BDMDA,BDMBD,BDMDAT,1,1)
QUIT
+53 SET ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMDA)=""
+54 SET ^TMP($JOB,"PATS",BDMCNT,BDMDA)=""
+55 IF BDMCALL="DM Audit P 16"
Begin DoDot:3
+56 SET ^XTMP("BDMPD1",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+57 IF BDMTYP="C"
Begin DoDot:1
+58 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+59 IF $GET(BDMCMSE)=""
QUIT
+60 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+61 IF 'BDMCMS
QUIT
+62 NEW BDMDA,BDMCNT
+63 SET BDMCNT=0
+64 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+65 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+66 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+67 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+68 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+69 IF BDMBEN=1
IF $$BEN^AUPNPAT(BDMRPAT,"C")'="01"
QUIT
+70 IF BDMBEN=2
IF $$BEN^AUPNPAT(BDMRPAT,"C")="01"
QUIT
+71 IF BDMPREG="E"
IF $$PREG^BDMDD1B(BDMRPAT,BDMBD,BDMDAT,1,1)
QUIT
+72 SET ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMRPAT)=""
+73 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U,1)=BDMSTAT
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,BDMRPAT)=""
+74 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,BDMRPAT)=""
+75 IF BDMCALL="DM Audit P 16"
Begin DoDot:3
+76 SET ^XTMP("BDMPD1",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+77 IF BDMRAND="Y"
Begin DoDot:1
+78 NEW X
+79 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
+80 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))=""
+81 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
End DoDot:2
+82 KILL ^XTMP("BDMDM16",BDMJ,BDMH,"PATS")
+83 SET (X,BDMCNT)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET BDMCNT=BDMCNT+1
+84 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("BDMDM16",BDMJ,BDMH,"PATS",X)=""
SET C=C+1
KILL ^TMP($JOB,"PATS",I,X)
+85 KILL ^TMP($JOB,"PATS")
End DoDot:1
+86 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+87 IF BDMCALL="DM Audit 2016"
Begin DoDot:1
+88 DO BDMG^BDMDD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
End DoDot:1
+89 IF BDMCALL="DM Audit P 16"
Begin DoDot:1
+90 DO BDMG^BDMPD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
End DoDot:1
+91 IF BDMCALL="DM Audit E 16"
Begin DoDot:1
+92 DO BDMG^BDMDD1E(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,BDMDZ2,BDMDEMO)
End DoDot:1
+93 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO16
QUIT
+94 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+95 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+96 DO EN^XBVK("BDM")
+97 QUIT
+98 ;
DMA16P(BDMRET,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 BDMRET="^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 BDMRGI=$PIECE(BDMSTR,P)
+12 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+13 SET BDMDAT=$PIECE(BDMSTR,P,2)
+14 SET BDMBD=($EXTRACT(BDMDAT,1,3)-1)_$EXTRACT(BDMDAT,4,7)
SET BDMBD=$$FMADD^XLFDT(BDMBD,1)
+15 SET BDMTYP=$PIECE(BDMSTR,P,3)
+16 SET BDMPCP=$PIECE(BDMSTR,P,5)
+17 SET BDMCOM=$PIECE(BDMSTR,P,6)
+18 SET BDMRAND=$PIECE(BDMSTR,P,7)
+19 SET BDMRCNT=$PIECE(BDMSTR,P,8)
+20 SET BDMSTAT=$PIECE(BDMSTR,P,9)
+21 SET BDMPREP=$PIECE(BDMSTR,P,10)
+22 SET BDMFILE=$PIECE(BDMSTR,P,11)
+23 SET BDMPNA=$PIECE(BDMSTR,P,15)
+24 SET BDMDSP=$PIECE(BDMSTR,P,16)
+25 SET BDMSDPI=$PIECE(BDMSTR,P,12)
+26 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
+27 SET BDMCALL=$PIECE(BDMSTR,P,14)
+28 SET BDMDZ2=$PIECE(BDMSTR,P,17)
+29 SET BDMDEMO=$PIECE(BDMSTR,P,18)
+30 SET BDMBEN=$PIECE(BDMSTR,P,19)
+31 SET BDMPREG=$PIECE(BDMSTR,P,20)
+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))=""
End DoDot:2
IF $PIECE(BDMPATS,R,I)=""
QUIT
End DoDot:1
+38 IF BDMTYP="S"
Begin DoDot:1
+39 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
+40 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
+41 IF 'BDMSTMP
QUIT
+42 NEW BDMDA
+43 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+44 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
QUIT
+45 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
QUIT
+46 IF BDMPREG="E"
IF $$PREG^BDMDD1B(BDMDA,BDMBD,BDMDAT,1,1)
QUIT
+47 SET ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:2
End DoDot:1
+48 IF BDMTYP="C"
Begin DoDot:1
+49 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+50 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+51 IF 'BDMCMS
QUIT
+52 NEW BDMDA
+53 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+54 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+55 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+56 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+57 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+58 IF BDMPREG="E"
IF $$PREG^BDMDD1B(BDMRPAT,BDMBD,BDMDAT,1,1)
QUIT
+59 SET ^XTMP("BDMDM16",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:2
End DoDot:1
+60 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+61 DO BDMG^BDMDD1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
+62 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO16
QUIT
+63 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+64 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+65 QUIT
+66 ;
NOWDMO16 ;EP - return the output to the screen
+1 NEW BDMI,BDMDA
+2 SET BDMI=0
+3 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+4 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^TMP($JOB,"BDMDM16",BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+5 SET BDMI=BDMI+1
+6 SET ^BDMTMP($JOB,BDMI)=$GET(^TMP($JOB,"BDMDM16",BDMDA))_$CHAR(30)
End DoDot:1
+7 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)+$GET(BDMERR)
+8 QUIT
+9 ;
DMA17(RETVAL,BDMSTR) ;-- dm audit 2017
+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 17"
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("BDMDM17",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
+38 IF BDMCALL="DM Audit P 17"
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
QUIT
+49 SET BDMCNT=BDMCNT+1
+50 IF BDMBEN=1
IF $$BEN^AUPNPAT(BDMDA,"C")'="01"
QUIT
+51 IF BDMBEN=2
IF $$BEN^AUPNPAT(BDMDA,"C")="01"
QUIT
+52 IF BDMPREG="E"
IF $$PREG^BDMDE1B(BDMDA,BDMBD,BDMDAT,1,1)
QUIT
+53 SET ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMDA)=""
+54 SET ^TMP($JOB,"PATS",BDMCNT,BDMDA)=""
+55 IF BDMCALL="DM Audit P 17"
Begin DoDot:3
+56 SET ^XTMP("BDMPE1",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:3
End DoDot:2
End DoDot:1
+57 IF BDMTYP="C"
Begin DoDot:1
+58 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+59 IF $GET(BDMCMSE)=""
QUIT
+60 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+61 IF 'BDMCMS
QUIT
+62 NEW BDMDA,BDMCNT
+63 SET BDMCNT=0
+64 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+65 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+66 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+67 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+68 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+69 IF BDMBEN=1
IF $$BEN^AUPNPAT(BDMRPAT,"C")'="01"
QUIT
+70 IF BDMBEN=2
IF $$BEN^AUPNPAT(BDMRPAT,"C")="01"
QUIT
+71 IF BDMPREG="E"
IF $$PREG^BDMDE1B(BDMRPAT,BDMBD,BDMDAT,1,1)
QUIT
+72 SET ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMRPAT)=""
+73 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U,1)=BDMSTAT
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,BDMRPAT)=""
+74 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,BDMRPAT)=""
+75 IF BDMCALL="DM Audit P 17"
Begin DoDot:3
+76 SET ^XTMP("BDMPE1",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:3
End DoDot:2
End DoDot:1
+77 IF BDMRAND="Y"
Begin DoDot:1
+78 NEW X
+79 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
+80 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))=""
+81 IF BDMSTAT=""
SET BDMCNT=BDMCNT+1
SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
End DoDot:2
+82 KILL ^XTMP("BDMDM17",BDMJ,BDMH,"PATS")
+83 SET (X,BDMCNT)=0
FOR
SET X=$ORDER(^TMP($JOB,"PATS",X))
IF X'=+X
QUIT
SET BDMCNT=BDMCNT+1
+84 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("BDMDM17",BDMJ,BDMH,"PATS",X)=""
SET C=C+1
KILL ^TMP($JOB,"PATS",I,X)
+85 KILL ^TMP($JOB,"PATS")
End DoDot:1
+86 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+87 IF BDMCALL="DM Audit 2017"
Begin DoDot:1
+88 DO BDMG^BDMDE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
End DoDot:1
+89 IF BDMCALL="DM Audit P 17"
Begin DoDot:1
+90 DO BDMG^BDMPE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
End DoDot:1
+91 IF BDMCALL="DM Audit E 17"
Begin DoDot:1
+92 DO BDMG^BDMDE1E(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,BDMDZ2,BDMDEMO)
End DoDot:1
+93 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO17
QUIT
+94 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+95 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+96 DO EN^XBVK("BDM")
+97 QUIT
+98 ;
DMA17P(BDMRET,BDMSTR) ;-- dm audit 2017
+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 BDMRET="^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 BDMRGI=$PIECE(BDMSTR,P)
+12 SET BDMRG=$ORDER(^ACM(41.1,"B",BDMRGI,0))
+13 SET BDMDAT=$PIECE(BDMSTR,P,2)
+14 SET BDMBD=($EXTRACT(BDMDAT,1,3)-1)_$EXTRACT(BDMDAT,4,7)
SET BDMBD=$$FMADD^XLFDT(BDMBD,1)
+15 SET BDMTYP=$PIECE(BDMSTR,P,3)
+16 SET BDMPCP=$PIECE(BDMSTR,P,5)
+17 SET BDMCOM=$PIECE(BDMSTR,P,6)
+18 SET BDMRAND=$PIECE(BDMSTR,P,7)
+19 SET BDMRCNT=$PIECE(BDMSTR,P,8)
+20 SET BDMSTAT=$PIECE(BDMSTR,P,9)
+21 SET BDMPREP=$PIECE(BDMSTR,P,10)
+22 SET BDMFILE=$PIECE(BDMSTR,P,11)
+23 SET BDMPNA=$PIECE(BDMSTR,P,15)
+24 SET BDMDSP=$PIECE(BDMSTR,P,16)
+25 SET BDMSDPI=$PIECE(BDMSTR,P,12)
+26 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
+27 SET BDMCALL=$PIECE(BDMSTR,P,14)
+28 SET BDMDZ2=$PIECE(BDMSTR,P,17)
+29 SET BDMDEMO=$PIECE(BDMSTR,P,18)
+30 SET BDMBEN=$PIECE(BDMSTR,P,19)
+31 SET BDMPREG=$PIECE(BDMSTR,P,20)
+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("BDMDM17",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
End DoDot:2
IF $PIECE(BDMPATS,R,I)=""
QUIT
End DoDot:1
+38 IF BDMTYP="S"
Begin DoDot:1
+39 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
+40 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
+41 IF 'BDMSTMP
QUIT
+42 NEW BDMDA
+43 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+44 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
QUIT
+45 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
QUIT
+46 IF BDMPREG="E"
IF $$PREG^BDMDE1B(BDMDA,BDMBD,BDMDAT,1,1)
QUIT
+47 SET ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMDA)=""
End DoDot:2
End DoDot:1
+48 IF BDMTYP="C"
Begin DoDot:1
+49 SET BDMCMSE=$PIECE(BDMSTR,P,4)
+50 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
+51 IF 'BDMCMS
QUIT
+52 NEW BDMDA
+53 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:2
+54 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
+55 IF $GET(BDMCOM)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
QUIT
+56 IF $GET(BDMPCP)
IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
QUIT
+57 IF $GET(BDMSTAT)]""
IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
QUIT
+58 IF BDMPREG="E"
IF $$PREG^BDMDE1B(BDMRPAT,BDMBD,BDMDAT,1,1)
QUIT
+59 SET ^XTMP("BDMDM17",BDMJ,BDMH,"PATS",BDMRPAT)=""
End DoDot:2
End DoDot:1
+60 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
+61 DO BDMG^BDMDE1(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,BDMPNA,BDMDZ2,BDMDEMO,BDMBEN)
+62 IF $GET(BDMDSP)
SET BDMIEN=1
DO NOWDMO17
QUIT
+63 IF '$GET(BDMIEN)
SET BDMERR="Error Queueing DM Audit"
+64 IF '$GET(BDMDSP)
SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
+65 QUIT
+66 ;
NOWDMO17 ;EP - return the output to the screen
+1 NEW BDMI,BDMDA
+2 SET BDMI=0
+3 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
+4 SET BDMDA=0
FOR
SET BDMDA=$ORDER(^TMP($JOB,"BDMDM17",BDMDA))
IF 'BDMDA
QUIT
Begin DoDot:1
+5 SET BDMI=BDMI+1
+6 SET ^BDMTMP($JOB,BDMI)=$GET(^TMP($JOB,"BDMDM17",BDMDA))_$CHAR(30)
End DoDot:1
+7 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)+$GET(BDMERR)
+8 QUIT
+9 ;
