- BDMGRF ; IHS/CMI/LAB - BDM DMS GUI Reports ; 09 Feb 2010 7:38 AM
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,6,7,8**;JUN 14, 2007;Build 53
- ;
- DEBUG(BDMRET,BDMSTR) ;-- debugger
- D DEBUG^%Serenji("DMA12P^BDMGRE(.BDMRET,.BDMSTR)")
- Q
- ;
- DMA13(RETVAL,BDMSTR) ;-- dm audit 2013
- 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
- S BDMH=$H,BDMJ=$J
- S P="|",R="~"
- S RETVAL="^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 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)
- I BDMCALL="DM Audit E 12" 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("BDMDM13",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
- .. I BDMCALL="DM Audit P 13" D
- ... S ^XTMP("BDMP13",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("BDMDM13",BDMJ,BDMH,"PATS",BDMDA)=""
- .. I BDMCALL="DM Audit P 13" D
- ... S ^XTMP("BDMP13",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("BDMDM13",BDMJ,BDMH,"PATS",BDMRPAT)=""
- .. I BDMCALL="DM Audit P 13" D
- ... S ^XTMP("BDMP13",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("BDMDM13",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("BDMDM12",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 2013" D
- . D BDMG^BDMDA1(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)
- I BDMCALL="DM Audit P 13" D
- . D BDMG^BDMPA1(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)
- I BDMCALL="DM Audit E 13" D
- . D BDMG^BDMDA1E(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 NOWDMO13 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
- ;
- DMA13P(BDMRET,BDMSTR) ;-- dm audit 2013
- 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
- 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 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)
- 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("BDMDM13",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("BDMDM13",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("BDMDM13",BDMJ,BDMH,"PATS",BDMRPAT)=""
- I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)
- D BDMG^BDMDA1(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)
- I $G(BDMDSP) S BDMIEN=1 D NOWDMO13 Q
- I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
- I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
- Q
- ;
- NOWDMO13 ;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,"BDMDM13",BDMDA)) Q:'BDMDA D
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDM13",BDMDA))_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)+$G(BDMERR)
- Q
- ;
- DMA14(RETVAL,BDMSTR) ;-- dm audit 2014
- 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
- S BDMH=$H,BDMJ=$J
- S P="|",R="~"
- S RETVAL="^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 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)
- I BDMCALL="DM Audit E 14" 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("BDMDM15",BDMJ,BDMH,"PATS",$P(BDMPATS,R,I))=""
- .. I BDMCALL="DM Audit P 14" D
- ... S ^XTMP("BDMP14",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("BDMDM15",BDMJ,BDMH,"PATS",BDMDA)=""
- .. I BDMCALL="DM Audit P 14" D
- ... S ^XTMP("BDMP14",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("BDMDM15",BDMJ,BDMH,"PATS",BDMRPAT)=""
- .. I BDMCALL="DM Audit P 14" D
- ... S ^XTMP("BDMP14",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("BDMDM15",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("BDMDM14",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 2015" D
- . D BDMG^BDMDC1(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)
- I BDMCALL="DM Audit P 14" D
- . D BDMG^BDMPB1(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)
- I BDMCALL="DM Audit E 14" D
- . D BDMG^BDMDC1E(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 NOWDMO14 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
- ;
- DMA14P(BDMRET,BDMSTR) ;-- dm audit 2014
- 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
- 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 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)
- 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("BDMDM15",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("BDMDM15",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("BDMDM15",BDMJ,BDMH,"PATS",BDMRPAT)=""
- I '$G(BDMDSP) S ^BDMTMP($J,1)="T00010REPORTIEN"_$C(30)
- D BDMG^BDMDC1(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)
- I $G(BDMDSP) S BDMIEN=1 D NOWDMO14 Q
- I '$G(BDMIEN) S BDMERR="Error Queueing DM Audit"
- I '$G(BDMDSP) S ^BDMTMP($J,2)=$C(31)_$G(BDMERR)
- Q
- ;
- NOWDMO14 ;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,"BDMDM15",BDMDA)) Q:'BDMDA D
- . S BDMI=BDMI+1
- . S ^BDMTMP($J,BDMI)=$G(^TMP($J,"BDMDM15",BDMDA))_$C(30)
- S ^BDMTMP($J,BDMI+1)=$C(31)+$G(BDMERR)
- Q
- ;
- TB(RETVAL,BDMSTR) ;-- glucose self monitoring report
- N BDMRG,BDMST,BDGTY,BDMDMO,BDME,BDMSRT,P
- S P="|"
- S BDMRG=$P(BDMSTR,P)
- S BDMTY=$S($G(BDMRG)]"":"R",1:"A")
- S BDMRDA=$S($G(BDMRG)]"":$O(^ACM(41.1,"B",BDMRG,0)),1:"")
- S BDMST=$P(BDMSTR,P,2)
- S BDMDMO=$P(BDMSTR,P,3)
- S BDMI=0
- S BDMERR=""
- K ^BDMTMP($J)
- S RETVAL="^BDMTMP("_$J_")"
- S ^BDMTMP($J,BDMI)="T00250DATA"_$C(30)
- S IOM=80
- D BDMG^BDMDR4(BDMTY,BDMRDA,BDMST,BDMDMO)
- S ^BDMTMP($J,1)=$C(31)_$G(BDMERR)
- D EN^XBVK("BDM")
- Q
- ;
- BDMGRF ; IHS/CMI/LAB - BDM DMS GUI Reports ; 09 Feb 2010 7:38 AM
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,6,7,8**;JUN 14, 2007;Build 53
- +2 ;
- DEBUG(BDMRET,BDMSTR) ;-- debugger
- +1 DO DEBUG^%Serenji("DMA12P^BDMGRE(.BDMRET,.BDMSTR)")
- +2 QUIT
- +3 ;
- DMA13(RETVAL,BDMSTR) ;-- dm audit 2013
- +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
- +5 SET BDMH=$HOROLOG
- SET BDMJ=$JOB
- +6 SET P="|"
- SET R="~"
- +7 SET RETVAL="^BDMTMP("_$JOB_")"
- +8 IF $GET(BDMSTR)=""
- SET BDMSTR=$$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 BDMTYP=$PIECE(BDMSTR,P,3)
- +13 SET BDMPCP=$PIECE(BDMSTR,P,5)
- +14 SET BDMCOM=$PIECE(BDMSTR,P,6)
- +15 SET BDMRAND=$PIECE(BDMSTR,P,7)
- +16 SET BDMRCNT=$PIECE(BDMSTR,P,8)
- +17 SET BDMSTAT=$PIECE(BDMSTR,P,9)
- +18 SET BDMPREP=$PIECE(BDMSTR,P,10)
- +19 SET BDMFILE=$PIECE(BDMSTR,P,11)
- +20 SET BDMPNA=$PIECE(BDMSTR,P,15)
- +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 SET BDMDZ2=$PIECE(BDMSTR,P,17)
- +26 SET BDMDEMO=$PIECE(BDMSTR,P,18)
- +27 IF BDMCALL="DM Audit E 12"
- Begin DoDot:1
- +28 SET BDMTYP=""
- End DoDot:1
- +29 IF BDMTYP="P"
- Begin DoDot:1
- +30 SET BDMPATS=$PIECE(BDMSTR,P,4)
- +31 NEW I
- +32 FOR I=1:1
- Begin DoDot:2
- +33 IF $PIECE(BDMPATS,R,I)=""
- QUIT
- +34 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- +35 IF BDMCALL="DM Audit P 13"
- Begin DoDot:3
- +36 SET ^XTMP("BDMP13",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- End DoDot:3
- End DoDot:2
- IF $PIECE(BDMPATS,R,I)=""
- QUIT
- End DoDot:1
- +37 IF BDMTYP="S"
- Begin DoDot:1
- +38 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
- +39 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
- +40 IF 'BDMSTMP
- QUIT
- +41 NEW BDMDA
- +42 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +43 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
- QUIT
- +44 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
- QUIT
- +45 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",BDMDA)=""
- +46 IF BDMCALL="DM Audit P 13"
- Begin DoDot:3
- +47 SET ^XTMP("BDMP13",BDMJ,BDMH,"PATS",BDMDA)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +48 IF BDMTYP="C"
- Begin DoDot:1
- +49 SET BDMCMSE=$PIECE(BDMSTR,P,4)
- +50 IF $GET(BDMCMSE)=""
- QUIT
- +51 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
- +52 IF 'BDMCMS
- QUIT
- +53 NEW BDMDA
- +54 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +55 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
- +56 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
- QUIT
- +57 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
- QUIT
- +58 IF $GET(BDMSTAT)]""
- IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
- QUIT
- +59 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",BDMRPAT)=""
- +60 IF BDMCALL="DM Audit P 13"
- Begin DoDot:3
- +61 SET ^XTMP("BDMP13",BDMJ,BDMH,"PATS",BDMRPAT)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +62 IF BDMRAND="Y"
- Begin DoDot:1
- +63 NEW X
- +64 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
- +65 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
- +66 IF BDMSTAT=""
- SET BDMCNT=BDMCNT+1
- SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
- End DoDot:2
- +67 KILL ^XTMP("BDMDM13",BDMJ,BDMH,"PATS")
- +68 SET (X,BDMCNT)=0
- FOR
- SET X=$ORDER(^TMP($JOB,"PATS",X))
- IF X'=+X
- QUIT
- SET BDMCNT=BDMCNT+1
- +69 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("BDMDM12",BDMJ,BDMH,"PATS",X)=""
- SET C=C+1
- KILL ^TMP($JOB,"PATS",I,X)
- +70 KILL ^TMP($JOB,"PATS")
- End DoDot:1
- +71 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
- +72 IF BDMCALL="DM Audit 2013"
- Begin DoDot:1
- +73 DO BDMG^BDMDA1(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)
- End DoDot:1
- +74 IF BDMCALL="DM Audit P 13"
- Begin DoDot:1
- +75 DO BDMG^BDMPA1(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)
- End DoDot:1
- +76 IF BDMCALL="DM Audit E 13"
- Begin DoDot:1
- +77 DO BDMG^BDMDA1E(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
- +78 IF $GET(BDMDSP)
- SET BDMIEN=1
- DO NOWDMO13
- QUIT
- +79 IF '$GET(BDMIEN)
- SET BDMERR="Error Queueing DM Audit"
- +80 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
- +81 DO EN^XBVK("BDM")
- +82 QUIT
- +83 ;
- DMA13P(BDMRET,BDMSTR) ;-- dm audit 2013
- +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
- +5 SET BDMH=$HOROLOG
- SET BDMJ=$JOB
- +6 SET P="|"
- SET R="~"
- +7 SET BDMRET="^BDMTMP("_$JOB_")"
- +8 IF $GET(BDMSTR)=""
- SET BDMSTR=$$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 BDMTYP=$PIECE(BDMSTR,P,3)
- +15 SET BDMPCP=$PIECE(BDMSTR,P,5)
- +16 SET BDMCOM=$PIECE(BDMSTR,P,6)
- +17 SET BDMRAND=$PIECE(BDMSTR,P,7)
- +18 SET BDMRCNT=$PIECE(BDMSTR,P,8)
- +19 SET BDMSTAT=$PIECE(BDMSTR,P,9)
- +20 SET BDMPREP=$PIECE(BDMSTR,P,10)
- +21 SET BDMFILE=$PIECE(BDMSTR,P,11)
- +22 SET BDMPNA=$PIECE(BDMSTR,P,15)
- +23 SET BDMDSP=$PIECE(BDMSTR,P,16)
- +24 SET BDMSDPI=$PIECE(BDMSTR,P,12)
- +25 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
- +26 SET BDMCALL=$PIECE(BDMSTR,P,14)
- +27 SET BDMDZ2=$PIECE(BDMSTR,P,17)
- +28 SET BDMDEMO=$PIECE(BDMSTR,P,18)
- +29 IF BDMTYP="P"
- Begin DoDot:1
- +30 SET BDMPATS=$PIECE(BDMSTR,P,4)
- +31 NEW I
- +32 FOR I=1:1
- Begin DoDot:2
- +33 IF $PIECE(BDMPATS,R,I)=""
- QUIT
- +34 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- End DoDot:2
- IF $PIECE(BDMPATS,R,I)=""
- QUIT
- End DoDot:1
- +35 IF BDMTYP="S"
- Begin DoDot:1
- +36 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
- +37 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
- +38 IF 'BDMSTMP
- QUIT
- +39 NEW BDMDA
- +40 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +41 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
- QUIT
- +42 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
- QUIT
- +43 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",BDMDA)=""
- End DoDot:2
- End DoDot:1
- +44 IF BDMTYP="C"
- Begin DoDot:1
- +45 SET BDMCMSE=$PIECE(BDMSTR,P,4)
- +46 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
- +47 IF 'BDMCMS
- QUIT
- +48 NEW BDMDA
- +49 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +50 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
- +51 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
- QUIT
- +52 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
- QUIT
- +53 IF $GET(BDMSTAT)]""
- IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
- QUIT
- +54 SET ^XTMP("BDMDM13",BDMJ,BDMH,"PATS",BDMRPAT)=""
- End DoDot:2
- End DoDot:1
- +55 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
- +56 DO BDMG^BDMDA1(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)
- +57 IF $GET(BDMDSP)
- SET BDMIEN=1
- DO NOWDMO13
- QUIT
- +58 IF '$GET(BDMIEN)
- SET BDMERR="Error Queueing DM Audit"
- +59 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
- +60 QUIT
- +61 ;
- NOWDMO13 ;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,"BDMDM13",BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +5 SET BDMI=BDMI+1
- +6 SET ^BDMTMP($JOB,BDMI)=$GET(^TMP($JOB,"BDMDM13",BDMDA))_$CHAR(30)
- End DoDot:1
- +7 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)+$GET(BDMERR)
- +8 QUIT
- +9 ;
- DMA14(RETVAL,BDMSTR) ;-- dm audit 2014
- +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
- +5 SET BDMH=$HOROLOG
- SET BDMJ=$JOB
- +6 SET P="|"
- SET R="~"
- +7 SET RETVAL="^BDMTMP("_$JOB_")"
- +8 IF $GET(BDMSTR)=""
- SET BDMSTR=$$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 BDMTYP=$PIECE(BDMSTR,P,3)
- +13 SET BDMPCP=$PIECE(BDMSTR,P,5)
- +14 SET BDMCOM=$PIECE(BDMSTR,P,6)
- +15 SET BDMRAND=$PIECE(BDMSTR,P,7)
- +16 SET BDMRCNT=$PIECE(BDMSTR,P,8)
- +17 SET BDMSTAT=$PIECE(BDMSTR,P,9)
- +18 SET BDMPREP=$PIECE(BDMSTR,P,10)
- +19 SET BDMFILE=$PIECE(BDMSTR,P,11)
- +20 SET BDMPNA=$PIECE(BDMSTR,P,15)
- +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 SET BDMDZ2=$PIECE(BDMSTR,P,17)
- +26 SET BDMDEMO=$PIECE(BDMSTR,P,18)
- +27 IF BDMCALL="DM Audit E 14"
- Begin DoDot:1
- +28 SET BDMTYP=""
- End DoDot:1
- +29 IF BDMTYP="P"
- Begin DoDot:1
- +30 SET BDMPATS=$PIECE(BDMSTR,P,4)
- +31 NEW I
- +32 FOR I=1:1
- Begin DoDot:2
- +33 IF $PIECE(BDMPATS,R,I)=""
- QUIT
- +34 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- +35 IF BDMCALL="DM Audit P 14"
- Begin DoDot:3
- +36 SET ^XTMP("BDMP14",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- End DoDot:3
- End DoDot:2
- IF $PIECE(BDMPATS,R,I)=""
- QUIT
- End DoDot:1
- +37 IF BDMTYP="S"
- Begin DoDot:1
- +38 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
- +39 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
- +40 IF 'BDMSTMP
- QUIT
- +41 NEW BDMDA
- +42 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +43 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
- QUIT
- +44 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
- QUIT
- +45 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMDA)=""
- +46 IF BDMCALL="DM Audit P 14"
- Begin DoDot:3
- +47 SET ^XTMP("BDMP14",BDMJ,BDMH,"PATS",BDMDA)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +48 IF BDMTYP="C"
- Begin DoDot:1
- +49 SET BDMCMSE=$PIECE(BDMSTR,P,4)
- +50 IF $GET(BDMCMSE)=""
- QUIT
- +51 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
- +52 IF 'BDMCMS
- QUIT
- +53 NEW BDMDA
- +54 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +55 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
- +56 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
- QUIT
- +57 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
- QUIT
- +58 IF $GET(BDMSTAT)]""
- IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
- QUIT
- +59 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMRPAT)=""
- +60 IF BDMCALL="DM Audit P 14"
- Begin DoDot:3
- +61 SET ^XTMP("BDMP14",BDMJ,BDMH,"PATS",BDMRPAT)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +62 IF BDMRAND="Y"
- Begin DoDot:1
- +63 NEW X
- +64 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
- +65 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
- +66 IF BDMSTAT=""
- SET BDMCNT=BDMCNT+1
- SET ^TMP($JOB,"PATS",BDMCNT,$PIECE(^ACM(41,X,0),U,2))=""
- End DoDot:2
- +67 KILL ^XTMP("BDMDM15",BDMJ,BDMH,"PATS")
- +68 SET (X,BDMCNT)=0
- FOR
- SET X=$ORDER(^TMP($JOB,"PATS",X))
- IF X'=+X
- QUIT
- SET BDMCNT=BDMCNT+1
- +69 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("BDMDM14",BDMJ,BDMH,"PATS",X)=""
- SET C=C+1
- KILL ^TMP($JOB,"PATS",I,X)
- +70 KILL ^TMP($JOB,"PATS")
- End DoDot:1
- +71 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
- +72 IF BDMCALL="DM Audit 2015"
- Begin DoDot:1
- +73 DO BDMG^BDMDC1(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)
- End DoDot:1
- +74 IF BDMCALL="DM Audit P 14"
- Begin DoDot:1
- +75 DO BDMG^BDMPB1(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)
- End DoDot:1
- +76 IF BDMCALL="DM Audit E 14"
- Begin DoDot:1
- +77 DO BDMG^BDMDC1E(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
- +78 IF $GET(BDMDSP)
- SET BDMIEN=1
- DO NOWDMO14
- QUIT
- +79 IF '$GET(BDMIEN)
- SET BDMERR="Error Queueing DM Audit"
- +80 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
- +81 DO EN^XBVK("BDM")
- +82 QUIT
- +83 ;
- DMA14P(BDMRET,BDMSTR) ;-- dm audit 2014
- +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
- +5 SET BDMH=$HOROLOG
- SET BDMJ=$JOB
- +6 SET P="|"
- SET R="~"
- +7 SET BDMRET="^BDMTMP("_$JOB_")"
- +8 IF $GET(BDMSTR)=""
- SET BDMSTR=$$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 BDMTYP=$PIECE(BDMSTR,P,3)
- +15 SET BDMPCP=$PIECE(BDMSTR,P,5)
- +16 SET BDMCOM=$PIECE(BDMSTR,P,6)
- +17 SET BDMRAND=$PIECE(BDMSTR,P,7)
- +18 SET BDMRCNT=$PIECE(BDMSTR,P,8)
- +19 SET BDMSTAT=$PIECE(BDMSTR,P,9)
- +20 SET BDMPREP=$PIECE(BDMSTR,P,10)
- +21 SET BDMFILE=$PIECE(BDMSTR,P,11)
- +22 SET BDMPNA=$PIECE(BDMSTR,P,15)
- +23 SET BDMDSP=$PIECE(BDMSTR,P,16)
- +24 SET BDMSDPI=$PIECE(BDMSTR,P,12)
- +25 SET BDMSDPIN=$PIECE(BDMSTR,P,13)
- +26 SET BDMCALL=$PIECE(BDMSTR,P,14)
- +27 SET BDMDZ2=$PIECE(BDMSTR,P,17)
- +28 SET BDMDEMO=$PIECE(BDMSTR,P,18)
- +29 IF BDMTYP="P"
- Begin DoDot:1
- +30 SET BDMPATS=$PIECE(BDMSTR,P,4)
- +31 NEW I
- +32 FOR I=1:1
- Begin DoDot:2
- +33 IF $PIECE(BDMPATS,R,I)=""
- QUIT
- +34 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",$PIECE(BDMPATS,R,I))=""
- End DoDot:2
- IF $PIECE(BDMPATS,R,I)=""
- QUIT
- End DoDot:1
- +35 IF BDMTYP="S"
- Begin DoDot:1
- +36 SET BDMSTMPE=$PIECE(BDMSTR,P,4)
- +37 SET BDMSTMP=$ORDER(^DIBT("B",BDMSTMPE,0))
- +38 IF 'BDMSTMP
- QUIT
- +39 NEW BDMDA
- +40 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^DIBT(BDMSTMP,1,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +41 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMDA,11)),U,17)'=BDMCOM
- QUIT
- +42 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMDA,0)),U,14)'=BDMPCP
- QUIT
- +43 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMDA)=""
- End DoDot:2
- End DoDot:1
- +44 IF BDMTYP="C"
- Begin DoDot:1
- +45 SET BDMCMSE=$PIECE(BDMSTR,P,4)
- +46 SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))
- +47 IF 'BDMCMS
- QUIT
- +48 NEW BDMDA
- +49 SET BDMDA=0
- FOR
- SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:2
- +50 SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)
- +51 IF $GET(BDMCOM)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,11)),U,17)'=BDMCOM
- QUIT
- +52 IF $GET(BDMPCP)
- IF $PIECE($GET(^AUPNPAT(BDMRPAT,0)),U,14)'=BDMPCP
- QUIT
- +53 IF $GET(BDMSTAT)]""
- IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT
- QUIT
- +54 SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMRPAT)=""
- End DoDot:2
- End DoDot:1
- +55 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,1)="T00010REPORTIEN"_$CHAR(30)
- +56 DO BDMG^BDMDC1(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)
- +57 IF $GET(BDMDSP)
- SET BDMIEN=1
- DO NOWDMO14
- QUIT
- +58 IF '$GET(BDMIEN)
- SET BDMERR="Error Queueing DM Audit"
- +59 IF '$GET(BDMDSP)
- SET ^BDMTMP($JOB,2)=$CHAR(31)_$GET(BDMERR)
- +60 QUIT
- +61 ;
- NOWDMO14 ;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,"BDMDM15",BDMDA))
- IF 'BDMDA
- QUIT
- Begin DoDot:1
- +5 SET BDMI=BDMI+1
- +6 SET ^BDMTMP($JOB,BDMI)=$GET(^TMP($JOB,"BDMDM15",BDMDA))_$CHAR(30)
- End DoDot:1
- +7 SET ^BDMTMP($JOB,BDMI+1)=$CHAR(31)+$GET(BDMERR)
- +8 QUIT
- +9 ;
- TB(RETVAL,BDMSTR) ;-- glucose self monitoring report
- +1 NEW BDMRG,BDMST,BDGTY,BDMDMO,BDME,BDMSRT,P
- +2 SET P="|"
- +3 SET BDMRG=$PIECE(BDMSTR,P)
- +4 SET BDMTY=$SELECT($GET(BDMRG)]"":"R",1:"A")
- +5 SET BDMRDA=$SELECT($GET(BDMRG)]"":$ORDER(^ACM(41.1,"B",BDMRG,0)),1:"")
- +6 SET BDMST=$PIECE(BDMSTR,P,2)
- +7 SET BDMDMO=$PIECE(BDMSTR,P,3)
- +8 SET BDMI=0
- +9 SET BDMERR=""
- +10 KILL ^BDMTMP($JOB)
- +11 SET RETVAL="^BDMTMP("_$JOB_")"
- +12 SET ^BDMTMP($JOB,BDMI)="T00250DATA"_$CHAR(30)
- +13 SET IOM=80
- +14 DO BDMG^BDMDR4(BDMTY,BDMRDA,BDMST,BDMDMO)
- +15 SET ^BDMTMP($JOB,1)=$CHAR(31)_$GET(BDMERR)
- +16 DO EN^XBVK("BDM")
- +17 QUIT
- +18 ;