BDMGRG.m

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

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8,9**;JUN 14, 2007;Build 78

 ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

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

 Q

 ;

DAL(RETVAL,BDMSTR) ;-- get audit logic values

 N P,BDMI,BDMYR,BDMYRI,BDMAL

 S P="|"

 S BDMI=0

 K ^BDMTMP($J)

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

 S @RETVAL@(BDMI)="T00010BMXIEN^T00080Logic"_$C(30)

 I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 S BDMYR=$P(BDMSTR,P)

 S BDMYRI=$O(^BDMDMTX("B",BDMYR,0))

 I '$G(BDMYRI) S BDMYRI=$O(^BDMDMTX("B",BDMYR_" DIABETES",0))

 S BDMDA=0 F  S BDMDA=$O(^BDMDMTX(BDMYRI,11,BDMDA)) Q:'BDMDA  D

 . Q:'$D(^BDMDMTX(BDMYRI,11,BDMDA,11))

 . S BDMAL=$P($G(^BDMDMTX(BDMYRI,11,BDMDA,0)),U)

 . S BDMI=BDMI+1

 . S @RETVAL@(BDMI)=BDMDA_U_BDMAL_$C(30)

 S @RETVAL@(BDMI+1)=$C(31)

 Q

 ;

DALD(RETVAL,BDMSTR) ;-- return the actual audit logic text

 N P,R,BDMA,BDME,BDMYR,BDMYRI,BDMDESC

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

 S BDMI=0

 K ^BDMTMP($J)

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

 S @RETVAL@(BDMI)="T00080Logic^T00250Description"_$C(30)

 I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 S BDMYR=$P(BDMSTR,P)

 S BDMYRI=$O(^BDMDMTX("B",BDMYR,0))

 I '$G(BDMYRI) S BDMYRI=$O(^BDMDMTX("B",BDMYR_" DIABETES",0))

 S BDMLOG=$P(BDMSTR,P,2)

 N I

 F I=1:1 D  Q:$P(BDMLOG,R,I)=""

 . S BDMA=$P(BDMLOG,R,I)

 . Q:BDMA=""

 . S BDME=$E(BDMA,1,30)

 . S BDMI=BDMI+1

 . S @RETVAL@(BDMI)=$P($G(^BDMDMTX(BDMYRI,11,BDMA,0)),U)_$C(30)

 . Q:$P(BDMLOG,R,I)=""

 . S BDMDA=0 F  S BDMDA=$O(^BDMDMTX(BDMYRI,11,BDMA,11,BDMDA)) Q:'BDMDA  D

 .. S BDMI=BDMI+1

 .. S BDMDESC=$G(^BDMDMTX(BDMYRI,11,BDMA,11,BDMDA,0))

 .. S @RETVAL@(BDMI)=BDMDESC_$C(30)

 . S BDMI=BDMI+1

 . S @RETVAL@(BDMI)=$C(30)

 S @RETVAL@(BDMI+1)=$C(31)

 Q

 ;

LM(RETVAL,BDMSTR) ;-- do the Lab/Med Report

 N P,R,BDMJ,BDMH,BDMB,BDME,BDMT

 S BDMJ=$J,BDMH=$H

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

 S BDMI=0

 K ^BDMTMP($J)

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

 S @RETVAL@(BDMI)="T00010Result"_$C(30)

 I $G(BDMSTR)="" S BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 S BDMT=$P(BDMSTR,P)

 S BDMB=$P(BDMSTR,P,2)

 S BDME=$P(BDMSTR,P,3)

 D BDMG^BDMLLMR(BDMJ,BDMH,BDMT,BDMB,BDME)

 S BDMI=BDMI+1

 S @RETVAL@(BDMI)=$C(30)

 S @RETVAL@(BDMI+1)=$C(31)

 Q

 ;

DMA15(RETVAL,BDMSTR) ;-- dm audit 2015

 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

 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 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)

 I BDMCALL="DM Audit E 15" 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 15" D

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

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

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

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

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

 .. S ^XTMP("BDMDM15",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 15" D

 ... S ^XTMP("BDMPC1",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("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("BDMDM15",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,BDMBEN)

 I BDMCALL="DM Audit P 15" D

 . D BDMG^BDMPC1(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 15" 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 NOWDMO15 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

 ;

DMA15P(BDMRET,BDMSTR) ;-- dm audit 2015

 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

 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 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)

 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,BDMBEN)

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

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

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

 Q

 ;

NOWDMO15 ;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

 ;

MASTER(RETVAL,BDMSTR)  ;EP - master list

 N P,R,I,J,K,L,BCM,BWF,BCOMM

 N REG,REGI,AGET,AGER,ST,STAT,CT,COMM,CMT,CM,WFT,WF,PSV,SSV,GENDER,TOR,ST,STI,DEMO,BDMI

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

 S BDMI=0

 K ^BDMTMP($J)

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

 I $G(BDMSTR)="" D CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 S REG=$P(BDMSTR,P)

 S REGI=$O(^ACM(41.1,"B",REG,0))

 S AGET=$P(BDMSTR,P,2)

 S ST=$P(BDMSTR,P,3)

 S STAT=$P(BDMSTR,P,4)

 F I=1:1 D  Q:$P(STAT,"*",I)=""

 . Q:$P(STAT,"*",I)=""

 . S BSTAT($P(STAT,"*",I))=""

 S CT=$P(BDMSTR,P,5)

 S COMM=$P(BDMSTR,P,6)

 F L=1:1 D  Q:$P(COMM,"*",L)=""

 . Q:$P(COMM,"*",L)=""

 . S BCOMM($P($P(COMM,"*",L),R))=""

 S CMT=$P(BDMSTR,P,7)

 S CM=$P(BDMSTR,P,8)

 F J=1:1 D  Q:$P(CM,"*",J)=""

 . Q:$P(CM,"*",J)=""

 . S BCM($P($P(CM,"*",J),R))=""

 S WFT=$P(BDMSTR,P,9)

 S WF=$P(BDMSTR,P,10)

 F K=1:1 D  Q:$P(WF,"*",K)=""

 . Q:$P(WF,"*",K)=""

 . S BWF($P($P(WF,"*",K),R))=""

 S PSV=$P(BDMSTR,P,11)

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

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

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

 S (ST,STI)=$P($P(BDMSTR,P,15),R)

 I $G(STI)'?.N S STI=$O(^DIBT("B",ST,0))

 I '$G(STI),ST]"" D

 . N FDA,FIENS,FERR

 . S FDA(.401,"+1,",.01)=ST

 . S FDA(.401,"+1,",2)=DT

 . S FDA(.401,"+1,",5)=DUZ

 . D UPDATE^DIE("","FDA","FIENS","FERR(1)")

 . S STI=$G(FIENS(1))

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

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

 D BDMG^BDMRML(.BDMERR,REGI,AGER,.BSTAT,CT,.BCOMM,GENDER,.BCM,.BWF,PSV,SSV,TOR,DEMO,$G(STI))

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

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

 Q

 ;

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

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8,9**;JUN 14, 2007;Build 78

 +2       ;

DEBUG(BDMRET,BDMSTR) ;-- debugger

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

 +2        QUIT 

 +3       ;

DAL(RETVAL,BDMSTR) ;-- get audit logic values

 +1        NEW P,BDMI,BDMYR,BDMYRI,BDMAL

 +2        SET P="|"

 +3        SET BDMI=0

 +4        KILL ^BDMTMP($JOB)

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

 +6        SET @RETVAL@(BDMI)="T00010BMXIEN^T00080Logic"_$CHAR(30)

 +7        IF $GET(BDMSTR)=""

               SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 +8        SET BDMYR=$PIECE(BDMSTR,P)

 +9        SET BDMYRI=$ORDER(^BDMDMTX("B",BDMYR,0))

 +10       IF '$GET(BDMYRI)

               SET BDMYRI=$ORDER(^BDMDMTX("B",BDMYR_" DIABETES",0))

 +11       SET BDMDA=0

           FOR 

               SET BDMDA=$ORDER(^BDMDMTX(BDMYRI,11,BDMDA))

               IF 'BDMDA

                   QUIT 

               Begin DoDot:1

 +12               IF '$DATA(^BDMDMTX(BDMYRI,11,BDMDA,11))

                       QUIT 

 +13               SET BDMAL=$PIECE($GET(^BDMDMTX(BDMYRI,11,BDMDA,0)),U)

 +14               SET BDMI=BDMI+1

 +15               SET @RETVAL@(BDMI)=BDMDA_U_BDMAL_$CHAR(30)

               End DoDot:1

 +16       SET @RETVAL@(BDMI+1)=$CHAR(31)

 +17       QUIT 

 +18      ;

DALD(RETVAL,BDMSTR) ;-- return the actual audit logic text

 +1        NEW P,R,BDMA,BDME,BDMYR,BDMYRI,BDMDESC

 +2        SET P="|"

           SET R="~"

 +3        SET BDMI=0

 +4        KILL ^BDMTMP($JOB)

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

 +6        SET @RETVAL@(BDMI)="T00080Logic^T00250Description"_$CHAR(30)

 +7        IF $GET(BDMSTR)=""

               SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

 +8        SET BDMYR=$PIECE(BDMSTR,P)

 +9        SET BDMYRI=$ORDER(^BDMDMTX("B",BDMYR,0))

 +10       IF '$GET(BDMYRI)

               SET BDMYRI=$ORDER(^BDMDMTX("B",BDMYR_" DIABETES",0))

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

 +12       NEW I

 +13       FOR I=1:1

               Begin DoDot:1

 +14               SET BDMA=$PIECE(BDMLOG,R,I)

 +15               IF BDMA=""

                       QUIT 

 +16               SET BDME=$EXTRACT(BDMA,1,30)

 +17               SET BDMI=BDMI+1

 +18               SET @RETVAL@(BDMI)=$PIECE($GET(^BDMDMTX(BDMYRI,11,BDMA,0)),U)_$CHAR(30)

 +19               IF $PIECE(BDMLOG,R,I)=""

                       QUIT 

 +20               SET BDMDA=0

                   FOR 

                       SET BDMDA=$ORDER(^BDMDMTX(BDMYRI,11,BDMA,11,BDMDA))

                       IF 'BDMDA

                           QUIT 

                       Begin DoDot:2

 +21                       SET BDMI=BDMI+1

 +22                       SET BDMDESC=$GET(^BDMDMTX(BDMYRI,11,BDMA,11,BDMDA,0))

 +23                       SET @RETVAL@(BDMI)=BDMDESC_$CHAR(30)

                       End DoDot:2

 +24               SET BDMI=BDMI+1

 +25               SET @RETVAL@(BDMI)=$CHAR(30)

               End DoDot:1

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

                   QUIT 

 +26       SET @RETVAL@(BDMI+1)=$CHAR(31)

 +27       QUIT 

 +28      ;

LM(RETVAL,BDMSTR) ;-- do the Lab/Med Report

 +1        NEW P,R,BDMJ,BDMH,BDMB,BDME,BDMT

 +2        SET BDMJ=$JOB

           SET BDMH=$HOROLOG

 +3        SET P="|"

           SET R="~"

 +4        SET BDMI=0

 +5        KILL ^BDMTMP($JOB)

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

 +7        SET @RETVAL@(BDMI)="T00010Result"_$CHAR(30)

 +8        IF $GET(BDMSTR)=""

               SET BDMSTR=$$CATSTR^BDMGU(.BDMSTR,.BDMSTR)

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

 +10       SET BDMB=$PIECE(BDMSTR,P,2)

 +11       SET BDME=$PIECE(BDMSTR,P,3)

 +12       DO BDMG^BDMLLMR(BDMJ,BDMH,BDMT,BDMB,BDME)

 +13       SET BDMI=BDMI+1

 +14       SET @RETVAL@(BDMI)=$CHAR(30)

 +15       SET @RETVAL@(BDMI+1)=$CHAR(31)

 +16       QUIT 

 +17      ;

DMA15(RETVAL,BDMSTR) ;-- dm audit 2015

 +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

 +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 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       SET BDMBEN=$PIECE(BDMSTR,P,19)

 +28       IF BDMCALL="DM Audit E 15"

               Begin DoDot:1

 +29               SET BDMTYP=""

               End DoDot:1

 +30       IF BDMTYP="P"

               Begin DoDot:1

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

 +32               NEW I

 +33               FOR I=1:1

                       Begin DoDot:2

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

                               QUIT 

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

 +36                       IF BDMCALL="DM Audit P 15"

                               Begin DoDot:3

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

                               End DoDot:3

                       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,BDMCNT

 +43               SET BDMCNT=0

 +44               SET BDMDA=0

                   FOR 

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

                       IF 'BDMDA

                           QUIT 

                       Begin DoDot:2

 +45                       IF $GET(BDMCOM)

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

                                   QUIT 

 +46                       IF $GET(BDMPCP)

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

                                   QUIT 

 +47                       SET BDMCNT=BDMCNT+1

 +48                       IF BDMBEN=1

                               IF $$BEN^AUPNPAT(BDMDA,"C")'="01"

                                   QUIT 

 +49                       IF BDMBEN=2

                               IF $$BEN^AUPNPAT(BDMDA,"C")="01"

                                   QUIT 

 +50                       SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMDA)=""

 +51                       SET ^TMP($JOB,"PATS",BDMCNT,BDMDA)=""

 +52                       IF BDMCALL="DM Audit P 15"

                               Begin DoDot:3

 +53                               SET ^XTMP("BDMPC1",BDMJ,BDMH,"PATS",BDMDA)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +54       IF BDMTYP="C"

               Begin DoDot:1

 +55               SET BDMCMSE=$PIECE(BDMSTR,P,4)

 +56               IF $GET(BDMCMSE)=""

                       QUIT 

 +57               SET BDMCMS=$ORDER(^ACM(41.1,"B",BDMCMSE,0))

 +58               IF 'BDMCMS

                       QUIT 

 +59               NEW BDMDA,BDMCNT

 +60               SET BDMCNT=0

 +61               SET BDMDA=0

                   FOR 

                       SET BDMDA=$ORDER(^ACM(41,"B",BDMCMS,BDMDA))

                       IF 'BDMDA

                           QUIT 

                       Begin DoDot:2

 +62                       SET BDMRPAT=$PIECE($GET(^ACM(41,BDMDA,0)),U,2)

 +63                       IF $GET(BDMCOM)

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

                                   QUIT 

 +64                       IF $GET(BDMPCP)

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

                                   QUIT 

 +65                       IF $GET(BDMSTAT)]""

                               IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U)'=BDMSTAT

                                   QUIT 

 +66                       IF BDMBEN=1

                               IF $$BEN^AUPNPAT(BDMRPAT,"C")'="01"

                                   QUIT 

 +67                       IF BDMBEN=2

                               IF $$BEN^AUPNPAT(BDMRPAT,"C")="01"

                                   QUIT 

 +68                       SET ^XTMP("BDMDM15",BDMJ,BDMH,"PATS",BDMRPAT)=""

 +69                       IF BDMSTAT]""

                               IF $PIECE($GET(^ACM(41,BDMDA,"DT")),U,1)=BDMSTAT

                                   SET BDMCNT=BDMCNT+1

                                   SET ^TMP($JOB,"PATS",BDMCNT,BDMRPAT)=""

 +70                       IF BDMSTAT=""