Routine: BDMSELFM

BDMSELFM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,10**;JUN 14, 2007;Build 12

 ;SELF MONITORING REPORT

 ;This routine will go through the any selected Register

 ;and then see if the patient has an Self Monitoring Glucose Health Factor

 ;or SELF MONITORING DRUG TAXONOMY

EP ;EP - called from option interactive

 D EOJ

 W:$D(IOF) @IOF

 W !!,"This option will provide a list of patients on a register"

 W !,"(e.g. IHS Diabetes) that either are doing Self Monitoring of"

 W !,"Glucose or who are not doing Self Monitoring of Glucose."

 W !,"The following definitions/logic is used:"

 W !?5,"Yes, Doing self monitoring:"

 W !?7,"- the last health factor documented in the 365 days prior to the"

 W !?7,"end date is SELF MONITORING BLOOD GLUCOSE-YES"

 W !?7,"- the patient has had strips dispensed through pharmacy in "

 W !?7,"the 365 days prior to the end date."

 W !?5,"No, not doing self monitoring"

 W !?7,"- the last health factor documented in the 365 days prior to"

 W !?7,"the end date is SELF MONITORING BLOOD GLUCOSE-NO or SELF MONITORING"

 W !?7,"BLOOD GLUCOSE-REFUSED"

 W !?7,"- the patient has had no strips dispensed through pharmacy"

 W !?7,"- the patient has had neither strips dispensed nor a health"

 W !?7,"factor documented in the 365 days prior to the end date"

 W !!,"In the case of the following conflict:  the patient's last"

 W !,"health factor states NO or REFUSED but they have had strips"

 W !,"dispensed they will show up on each report with a status of"

 W !,"Maybe."

 ;W !!,"This option will print a list of all patients on a register"

REGISTER ;get register name

 S BDMREG=""

 W ! S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC

 I Y=-1 S BDMREG="" W !,"No Register Selected." G EOJ

 S BDMREG=+Y

 ;get status

 S BDMSTAT=""

 S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G REGISTER

 I Y=0 S BDMSTAT="" G REPORT

 ;which status

 S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G REGISTER

 S BDMSTAT=Y

REPORT ;

 S BDMRPT=""

 S DIR(0)="S^Y:YES, Doing Self Monitoring;N:NO, Not doing Self Monitoring;B:Both",DIR("A")="What list of patients do you want",DIR("B")="N" K DA D ^DIR KILL DIR

 I $D(DIRUT) G REGISTER

 S BDMRPT=Y

ENDDATE ;

 S BDMED=""

 W !!,"Enter the end date to use in calculating the 365 day time period."

 S DIR(0)="D^::EPX",DIR("A")="Enter the End Date" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G REPORT

 S BDMED=Y

SORTED ;

 K DIR S DIR(0)="SO^H:HRN;P:PATIENT NAME;C:COMMUNITY OF RESIDENCE",DIR("A")="How would you like the report sorted",DIR("B")="H" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) G ENDDATE

 S BDMSORT=Y

ZIS ;

 D DEMOCHK^BDMUTL(.BDMDEMO)

 I BDMDEMO=-1 Q

 S XBRP="PRINT^BDMSELFM",XBRC="PROC^BDMSELFM",XBRX="EOJ^BDMSELFM",XBNS="BDM"

 D ^XBDBQUE

EOJ ;

 D ^XBFMK

 K DIC,DIR

 D EN^XBVK("BDM")

PROC ;

 S BDMJ=$J,BDMH=$H

 S ^XTMP("BDMSELFM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"

 S BDMDMX=0 F  S BDMDMX=$O(^ACM(41,"B",BDMREG,BDMDMX)) Q:BDMDMX'=+BDMDMX  D

 .;check to see if patient has Self Monitoring or not

 .;check register status

 .I BDMSTAT]"",$P($G(^ACM(41,BDMDMX,"DT")),U,1)'=BDMSTAT Q

 .S DFN=$P(^ACM(41,BDMDMX,0),U,2)

 .Q:$$DOD^AUPNPAT(DFN)]""  ;don't display deceased patients

 .Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))

 .S BDMHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(BDMED,-365),"B")

 .I BDMHF["YES" S BDMHFG=1

 .I BDMHF="" S BDMHFG=""

 .I BDMHF["NO" S BDMHFG=0

 .I BDMHF["REFUSE" S BDMHFG=0

 .K BDMMED

 .S X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(BDMED,-365)_"-"_BDMED S E=$$START1^APCLDF(X,"BDMMED(")

 .I $D(BDMMED(1)) S BDMMEDG=1

 .I '$D(BDMMED(1)) S BDMMEDG=0

 .D SETVAL

 .I BDMRPT="Y",BDMVAL="N" Q

 .I BDMRPT="N",BDMVAL="Y" Q

 .S ^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",$$SORT(DFN,BDMSORT),DFN)=BDMHF_"||"_$G(BDMMED(1))_"||"_BDMVAL

.Q

SORT(P,BDMSORT) ;

 NEW X S X=""

 I BDMSORT="H" S X=$$HRN^AUPNPAT(P,DUZ(2))

 I BDMSORT="P" S X=$P(^DPT(P,0),U)

 I BDMSORT="C" S X=$$COMMRES^AUPNPAT(P)

 I X="" S X="----"

Q X

SETVAL ;

 S BDMVAL=""

 I BDMMEDG=1,BDMHFG=1 S BDMVAL="Y" Q

 I BDMMEDG=1,BDMHFG="" S BDMVAL="Y" Q

 I BDMMEDG=1,BDMHFG=0 S BDMVAL="M" Q

 I BDMHFG=1 S BDMVAL="Y" Q

 I BDMHFG=0 S BDMVAL="N" Q

 I BDMHFG="" S BDMVAL="N" Q

DONE ;

 I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 W:$D(IOF) @IOF

 K BDMTS,BDMS,BDMM,BDMET

 K ^XTMP("BDMSELFM",BDMJ,BDMH),BDMJ,BDMH

PRINT ;EP - called from xbdbque

 K BDMQ S BDMPG=0 D HEADER

 I '$D(^XTMP("BDMSELFM",BDMJ,BDMH)) W !!,"NO DATA TO REPORT",! G DONE

 S BDMSV="" F  S BDMSV=$O(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV)) Q:BDMSV=""!($D(BDMQ))  D

 .S DFN=0 F  S DFN=$O(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN)) Q:DFN'=+DFN!($D(BDMQ))  D

 ..I $Y>(IOSL-4) D HEADER Q:$D(BDMQ)

 ..I BDMRPT="Y" W !

 ..W !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,28),?38,$E($$COMMRES^AUPNPAT(DFN,"E"),1,15),?54,$$LASTVD^APCLV1(DFN,"E")

 ..S BDMVAL=$P(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",3)

 ..S BDMMED=$P(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",2)

 ..S BDMHF=$P(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",1)

 ..S X="",BDMLHF="",BDMLMED=""

 ..I BDMVAL="Y" S X="Yes"

 ..I BDMVAL="N" S X="No"

 ..I BDMVAL="M" S X="Maybe"

 ..;I BDMHF="",BDMMED="" S BDMLHF="Not documented" G PRINT1

 ..S BDMLHF=BDMHF

 ..S BDMLMED=$P(BDMMED,U,2)_$S($P(BDMMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($P(BDMMED,U),2)

PRINT1 ..W ?75,X

 ..I BDMLHF]"" W !?3,"Health Factor: ",BDMLHF

 ..I BDMLMED]"" W !?3,"Medication Dispensed: ",BDMLMED

 D DONE

HEADER ;EP

 G:'BDMPG HEADER1

 K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQ="" Q

HEADER1 ;

 W:$D(IOF) @IOF S BDMPG=BDMPG+1

 I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"

 W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!

 W !,$$CTR("PATIENTS ON THE "_$P(^ACM(41.1,BDMREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!

 I BDMRPT="Y" W $$CTR("Patients Doing Self Monitoring",80),!

 I BDMRPT="N" W $$CTR("Patients NOT Doing Self Monitoring",80),!

 I BDMRPT="B" W $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!

 S X="End Date: "_$$FMTE^XLFDT(BDMED) W $$CTR(X,80),!

 W !,"HRN",?7,"PATIENT NAME",?38,"COMMUNITY",?54,"LAST VISIT",?75,"SMBG?"

 W !,$TR($J("",80)," ","-")

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR("A")="End of report.  Press Enter",DIR(0)="E" D ^DIR

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

POST ;

 NEW X

 S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM REG APPT CLN","BDM")

 I 'X W "Attempt to new appt list of reg pats failed.." H 3

LASTHF(P,C,BDATE,F) ;EP - get last factor in category C for patient P

 I '$G(P) Q ""

 I $G(C)="" Q ""

 I $G(F)="" S F=""

 S C=$O(^AUTTHF("B",C,0)) ;ien of category passed

 I '$G(C) Q ""

 NEW H,D,O S H=0 K O

 F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D

 .  Q:'$D(^AUPNVHF("AA",P,H))

 .  S D=$O(^AUPNVHF("AA",P,H,""))

 .  Q:'D

 .  Q:(9999999-D)<BDATE

 .  S O(D)=$O(^AUPNVHF("AA",P,H,D,""))

 .  Q

 S D=$O(O(0))

 I D="" Q D

 I F="N" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)

 I F="S" Q $P($G(^AUPNVHF(O(D),0)),U,6)

 I F="B" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT((9999999-D),2)

 Q 9999999-D

BDMGA(BDMRET,BDMREG,BDMSTAT,BDMRPT,BDMED,BDMSORT,BDMGUI,BDMDEMO) ;PEP - gui call

 S BDMJ=$J

 S BDMH=$H

 I $G(BDMJ)="" S BDMRET=-1 Q

 I $G(BDMH)="" S BDMRET=-1 Q

 ;create entry in fileman file to hold output

 N BDMOPT  ;maw

 S BDMOPT="Glucose Self Monitoring"

 D NOW^%DTC

 S BDMNOW=$G(%)

 K DD,D0,DIC

 S X=DUZ_"."_BDMH

 S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05///1;.06///"_$G(BDMOPT)_";.07///R"

 S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003002.4

 D FILE^DICN

 K DIADD,DLAYGO,DIC,DA

 I Y=-1 S BDMRET=-1 Q

 S BDMIEN=+Y

 S BDMRET=BDMIEN

 D ^XBFMK

 K ZTSAVE S ZTSAVE("*")=""

 ;D GUIEP  ;for interactive testing

 S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMSELFM",ZTDESC="GUI GLUCOSE SELF MONITORING" D ^%ZTLOAD

 D EOJ

GUIEP ;EP - called from taskman ;Visiual DMS Entry Point

 D PROC

 K ^TMP($J,"BDMSELFM")

 S IOM=80  ;cmi/maw added

 D GUIR^XBLM("PRINT^BDMSELFM","^TMP($J,""BDMSELFM"",")

 ;Q:$G(BDMDSP)  ;quit if to screen

 S X=0,C=0 F  S X=$O(^TMP($J,"BDMSELFM",X)) Q:'X  D

 . N BDMGDATA

 . S BDMGDATA=^TMP($J,"BDMSELFM",X)

 . ;I BDMGDATA="ZZZZZZZ" S BDMGDATA=$C(12)

 . S ^BDMGUI(BDMIEN,11,X,0)=BDMGDATA

 . S C=C+1

 S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"

 S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK

 D ENDLOG

 S ZTREQ="@"

ENDLOG ;-- write the end of the log

 D NOW^%DTC

 S BDMNOW=$G(%)

 S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07///C"

 D ^DIE

 K DIE,DR,DA

BDMSELFM  ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,10**;JUN 14, 2007;Build 12

 +2       ;SELF MONITORING REPORT

 +3       ;

 +4       ;This routine will go through the any selected Register

 +5       ;and then see if the patient has an Self Monitoring Glucose Health Factor

 +6       ;or SELF MONITORING DRUG TAXONOMY

EP        ;EP - called from option interactive

 +1        DO EOJ

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This option will provide a list of patients on a register"

 +4        WRITE !,"(e.g. IHS Diabetes) that either are doing Self Monitoring of"

 +5        WRITE !,"Glucose or who are not doing Self Monitoring of Glucose."

 +6        WRITE !,"The following definitions/logic is used:"

 +7        WRITE !?5,"Yes, Doing self monitoring:"

 +8        WRITE !?7,"- the last health factor documented in the 365 days prior to the"

 +9        WRITE !?7,"end date is SELF MONITORING BLOOD GLUCOSE-YES"

 +10       WRITE !?7,"- the patient has had strips dispensed through pharmacy in "

 +11       WRITE !?7,"the 365 days prior to the end date."

 +12       WRITE !?5,"No, not doing self monitoring"

 +13       WRITE !?7,"- the last health factor documented in the 365 days prior to"

 +14       WRITE !?7,"the end date is SELF MONITORING BLOOD GLUCOSE-NO or SELF MONITORING"

 +15       WRITE !?7,"BLOOD GLUCOSE-REFUSED"

 +16       WRITE !?7,"- the patient has had no strips dispensed through pharmacy"

 +17       WRITE !?7,"- the patient has had neither strips dispensed nor a health"

 +18       WRITE !?7,"factor documented in the 365 days prior to the end date"

 +19       WRITE !!,"In the case of the following conflict:  the patient's last"

 +20       WRITE !,"health factor states NO or REFUSED but they have had strips"

 +21       WRITE !,"dispensed they will show up on each report with a status of"

 +22       WRITE !,"Maybe."

 +23      ;W !!,"This option will print a list of all patients on a register"

REGISTER  ;get register name

 +1        SET BDMREG=""

 +2        WRITE !

           SET DIC="^ACM(41.1,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter the Name of the Register: "

           DO ^DIC

 +3        IF Y=-1

               SET BDMREG=""

               WRITE !,"No Register Selected."

               GOTO EOJ

 +4        SET BDMREG=+Y

 +5       ;get status

 +6        SET BDMSTAT=""

 +7        SET DIR(0)="Y"

           SET DIR("A")="Do you want to select register patients with a particular status"

           SET DIR("B")="Y"

           KILL DA

           DO ^DIR

           KILL DIR

 +8        IF $DATA(DIRUT)

               GOTO REGISTER

 +9        IF Y=0

               SET BDMSTAT=""

               GOTO REPORT

 +10      ;which status

 +11       SET DIR(0)="9002241,1"

           SET DIR("A")="Which status"

           SET DIR("B")="A"

           KILL DA

           DO ^DIR

           KILL DIR

 +12       IF $DATA(DIRUT)

               GOTO REGISTER

 +13       SET BDMSTAT=Y

REPORT    ;

 +1        SET BDMRPT=""

 +2        SET DIR(0)="S^Y:YES, Doing Self Monitoring;N:NO, Not doing Self Monitoring;B:Both"

           SET DIR("A")="What list of patients do you want"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO REGISTER

 +4        SET BDMRPT=Y

ENDDATE   ;

 +1        SET BDMED=""

 +2        WRITE !!,"Enter the end date to use in calculating the 365 day time period."

 +3        SET DIR(0)="D^::EPX"

           SET DIR("A")="Enter the End Date"

           KILL DA

           DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               GOTO REPORT

 +5        SET BDMED=Y

SORTED    ;

 +1        KILL DIR

           SET DIR(0)="SO^H:HRN;P:PATIENT NAME;C:COMMUNITY OF RESIDENCE"

           SET DIR("A")="How would you like the report sorted"

           SET DIR("B")="H"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO ENDDATE

 +3        SET BDMSORT=Y

ZIS       ;

 +1        DO DEMOCHK^BDMUTL(.BDMDEMO)

 +2        IF BDMDEMO=-1

               QUIT

 +3        SET XBRP="PRINT^BDMSELFM"

           SET XBRC="PROC^BDMSELFM"

           SET XBRX="EOJ^BDMSELFM"

           SET XBNS="BDM"

 +4        DO ^XBDBQUE

 +5        QUIT

EOJ       ;

 +1        DO ^XBFMK

 +2        KILL DIC,DIR

 +3        DO EN^XBVK("BDM")

 +4        QUIT

 +5       ;

PROC      ;

 +1        SET BDMJ=$JOB

           SET BDMH=$HOROLOG

 +2        SET ^XTMP("BDMSELFM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"

 +3        SET BDMDMX=0

FOR

               SET BDMDMX=$ORDER(^ACM(41,"B",BDMREG,BDMDMX))

               IF BDMDMX'=+BDMDMX

                   QUIT

               Begin DoDot:1

 +4       ;check to see if patient has Self Monitoring or not

 +5       ;check register status

 +6                IF BDMSTAT]""

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

                           QUIT

 +7                SET DFN=$PIECE(^ACM(41,BDMDMX,0),U,2)

 +8       ;don't display deceased patients

                   IF $$DOD^AUPNPAT(DFN)]""

                       QUIT

 +9                IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))

                       QUIT

 +10               SET BDMHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(BDMED,-365),"B")

 +11               IF BDMHF["YES"

                       SET BDMHFG=1

 +12               IF BDMHF=""

                       SET BDMHFG=""

 +13               IF BDMHF["NO"

                       SET BDMHFG=0

 +14               IF BDMHF["REFUSE"

                       SET BDMHFG=0

 +15               KILL BDMMED

 +16               SET X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(BDMED,-365)_"-"_BDMED

                   SET E=$$START1^APCLDF(X,"BDMMED(")

 +17               IF $DATA(BDMMED(1))

                       SET BDMMEDG=1

 +18               IF '$DATA(BDMMED(1))

                       SET BDMMEDG=0

 +19               DO SETVAL

 +20               IF BDMRPT="Y"

                       IF BDMVAL="N"

                           QUIT

 +21               IF BDMRPT="N"

                       IF BDMVAL="Y"

                           QUIT

 +22               SET ^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",$$SORT(DFN,BDMSORT),DFN)=BDMHF_"||"_$GET(BDMMED(1))_"||"_BDMVAL

 +23               QUIT

               End DoDot:1

 +24       QUIT

SORT(P,BDMSORT) ;

 +1        NEW X

           SET X=""

 +2        IF BDMSORT="H"

               SET X=$$HRN^AUPNPAT(P,DUZ(2))

 +3        IF BDMSORT="P"

               SET X=$PIECE(^DPT(P,0),U)

 +4        IF BDMSORT="C"

               SET X=$$COMMRES^AUPNPAT(P)

 +5        IF X=""

               SET X="----"

 +6        QUIT X

SETVAL    ;

 +1        SET BDMVAL=""

 +2        IF BDMMEDG=1

               IF BDMHFG=1

                   SET BDMVAL="Y"

                   QUIT

 +3        IF BDMMEDG=1

               IF BDMHFG=""

                   SET BDMVAL="Y"

                   QUIT

 +4        IF BDMMEDG=1

               IF BDMHFG=0

                   SET BDMVAL="M"

                   QUIT

 +5        IF BDMHFG=1

               SET BDMVAL="Y"

               QUIT

 +6        IF BDMHFG=0

               SET BDMVAL="N"

               QUIT

 +7        IF BDMHFG=""

               SET BDMVAL="N"

               QUIT

 +8        QUIT

DONE      ;

 +1        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   SET DIR(0)="EO"

                   SET DIR("A")="End of report.  PRESS ENTER"

                   DO ^DIR

                   KILL DIR

                   IF $DATA(DUOUT)

                       SET DIRUT=1

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        KILL BDMTS,BDMS,BDMM,BDMET

 +4        KILL ^XTMP("BDMSELFM",BDMJ,BDMH),BDMJ,BDMH

 +5        QUIT

 +6       ;

PRINT     ;EP - called from xbdbque

 +1        KILL BDMQ

           SET BDMPG=0

           DO HEADER

 +2        IF '$DATA(^XTMP("BDMSELFM",BDMJ,BDMH))

               WRITE !!,"NO DATA TO REPORT",!

               GOTO DONE

 +3        SET BDMSV=""

FOR

               SET BDMSV=$ORDER(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV))

               IF BDMSV=""!($DATA(BDMQ))

                   QUIT

               Begin DoDot:1

 +4                SET DFN=0

FOR

                       SET DFN=$ORDER(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN))

                       IF DFN'=+DFN!($DATA(BDMQ))

                           QUIT

                       Begin DoDot:2

 +5                        IF $Y>(IOSL-4)

                               DO HEADER

                               IF $DATA(BDMQ)

                                   QUIT

 +6                        IF BDMRPT="Y"

                               WRITE !

 +7                        WRITE !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$EXTRACT($PIECE(^DPT(DFN,0),U),1,28),?38,$EXTRACT($$COMMRES^AUPNPAT(DFN,"E"),1,15),?54,$$LASTVD^APCLV1(DFN,"E")

 +8                        SET BDMVAL=$PIECE(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",3)

 +9                        SET BDMMED=$PIECE(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",2)

 +10                       SET BDMHF=$PIECE(^XTMP("BDMSELFM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",1)

 +11                       SET X=""

                           SET BDMLHF=""

                           SET BDMLMED=""

 +12                       IF BDMVAL="Y"

                               SET X="Yes"

 +13                       IF BDMVAL="N"

                               SET X="No"

 +14                       IF BDMVAL="M"

                               SET X="Maybe"

 +15      ;I BDMHF="",BDMMED="" S BDMLHF="Not documented" G PRINT1

 +16                       SET BDMLHF=BDMHF

 +17                       SET BDMLMED=$PIECE(BDMMED,U,2)_$SELECT($PIECE(BDMMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($PIECE(BDMMED,U),2)

PRINT1                     WRITE ?75,X

 +1                        IF BDMLHF]""

                               WRITE !?3,"Health Factor: ",BDMLHF

 +2                        IF BDMLMED]""

                               WRITE !?3,"Medication Dispensed: ",BDMLMED

                       End DoDot:2

               End DoDot:1

 +3        DO DONE

 +4        QUIT

HEADER    ;EP

 +1        IF 'BDMPG

               GOTO HEADER1

 +2        KILL DIR

           IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET BDMQ=""

                       QUIT

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET BDMPG=BDMPG+1

 +2        IF $GET(BDMGUI)

               IF BDMPG'=1

                   WRITE !,"ZZZZZZZ"

 +3        WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!

 +4        WRITE !,$$CTR("PATIENTS ON THE "_$PIECE(^ACM(41.1,BDMREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!

 +5        IF BDMRPT="Y"

               WRITE $$CTR("Patients Doing Self Monitoring",80),!

 +6        IF BDMRPT="N"

               WRITE $$CTR("Patients NOT Doing Self Monitoring",80),!

 +7        IF BDMRPT="B"

               WRITE $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!

 +8        SET X="End Date: "_$$FMTE^XLFDT(BDMED)

           WRITE $$CTR(X,80),!

 +9        WRITE !,"HRN",?7,"PATIENT NAME",?38,"COMMUNITY",?54,"LAST VISIT",?75,"SMBG?"

 +10       WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +11       QUIT

CTR(X,Y)  ;EP - Center X in a field Y wide.

 +1        QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X

 +2       ;----------

EOP       ;EP - End of page.

 +1        IF $EXTRACT(IOST)'="C"

               QUIT

 +2        IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))

               QUIT

 +3        NEW DIR

 +4        KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 +5        SET DIR("A")="End of report.  Press Enter"

           SET DIR(0)="E"

           DO ^DIR

 +6        QUIT

 +7       ;----------

USR()     ;EP - Return name of current user from ^VA(200.

 +1        QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 +2       ;----------

LOC()     ;EP - Return location name from file 4 based on DUZ(2).

 +1        QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 +2       ;----------

POST      ;

 +1        NEW X

 +2        SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM REG APPT CLN","BDM")

 +3        IF 'X

               WRITE "Attempt to new appt list of reg pats failed.."

               HANG 3

 +4        QUIT

LASTHF(P,C,BDATE,F) ;EP - get last factor in category C for patient P

 +1        IF '$GET(P)

               QUIT ""

 +2        IF $GET(C)=""

               QUIT ""

 +3        IF $GET(F)=""

               SET F=""

 +4       ;ien of category passed

           SET C=$ORDER(^AUTTHF("B",C,0))

 +5        IF '$GET(C)

               QUIT ""

 +6        NEW H,D,O

           SET H=0

           KILL O

 +7        FOR

               SET H=$ORDER(^AUTTHF("AC",C,H))

               IF '+H

                   QUIT

               Begin DoDot:1

 +8                IF '$DATA(^AUPNVHF("AA",P,H))

                       QUIT

 +9                SET D=$ORDER(^AUPNVHF("AA",P,H,""))

 +10               IF 'D

                       QUIT

 +11               IF (9999999-D)<BDATE

                       QUIT

 +12               SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))

 +13               QUIT

               End DoDot:1

 +14       SET D=$ORDER(O(0))

 +15       IF D=""

               QUIT D

 +16       IF F="N"

               QUIT $$VAL^XBDIQ1(9000010.23,O(D),.01)

 +17       IF F="S"

               QUIT $PIECE($GET(^AUPNVHF(O(D),0)),U,6)

 +18       IF F="B"

               QUIT $$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT((9999999-D),2)

 +19       QUIT 9999999-D

 +20      ;

BDMGA(BDMRET,BDMREG,BDMSTAT,BDMRPT,BDMED,BDMSORT,BDMGUI,BDMDEMO) ;PEP - gui call

 +1        SET BDMJ=$JOB

 +2        SET BDMH=$HOROLOG

 +3        IF $GET(BDMJ)=""

               SET BDMRET=-1

               QUIT

 +4        IF $GET(BDMH)=""

               SET BDMRET=-1

               QUIT

 +5       ;create entry in fileman file to hold output

 +6       ;maw

           NEW BDMOPT

 +7        SET BDMOPT="Glucose Self Monitoring"

 +8        DO NOW^%DTC

 +9        SET BDMNOW=$GET(%)

 +10       KILL DD,D0,DIC

 +11       SET X=DUZ_"."_BDMH

 +12       SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05///1;.06///"_$GET(BDMOPT)_";.07///R"

 +13       SET DIC="^BDMGUI("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9003002.4

 +14       DO FILE^DICN

 +15       KILL DIADD,DLAYGO,DIC,DA

 +16       IF Y=-1

               SET BDMRET=-1

               QUIT

 +17       SET BDMIEN=+Y

 +18       SET BDMRET=BDMIEN

 +19       DO ^XBFMK

 +20       KILL ZTSAVE

           SET ZTSAVE("*")=""

 +21      ;D GUIEP  ;for interactive testing

 +22       SET ZTIO=""

           SET ZTDTH=$$NOW^XLFDT

           SET ZTRTN="GUIEP^BDMSELFM"

           SET ZTDESC="GUI GLUCOSE SELF MONITORING"

           DO ^%ZTLOAD

 +23       DO EOJ

 +24       QUIT

GUIEP     ;EP - called from taskman ;Visiual DMS Entry Point

 +1        DO PROC

 +2        KILL ^TMP($JOB,"BDMSELFM")

 +3       ;cmi/maw added

           SET IOM=80

 +4        DO GUIR^XBLM("PRINT^BDMSELFM","^TMP($J,""BDMSELFM"",")

 +5       ;Q:$G(BDMDSP)  ;quit if to screen

 +6        SET X=0

           SET C=0

FOR

               SET X=$ORDER(^TMP($JOB,"BDMSELFM",X))

               IF 'X

                   QUIT

               Begin DoDot:1

 +7                NEW BDMGDATA

 +8                SET BDMGDATA=^TMP($JOB,"BDMSELFM",X)

 +9       ;I BDMGDATA="ZZZZZZZ" S BDMGDATA=$C(12)

 +10               SET ^BDMGUI(BDMIEN,11,X,0)=BDMGDATA

 +11               SET C=C+1

               End DoDot:1

 +12       SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"

 +13       SET DA=BDMIEN

           SET DIK="^BDMGUI("

           DO IX1^DIK

 +14       DO ENDLOG

 +15       SET ZTREQ="@"

 +16       QUIT

 +17      ;

ENDLOG    ;-- write the end of the log

 +1        DO NOW^%DTC

 +2        SET BDMNOW=$GET(%)

 +3        SET DIE="^BDMGUI("

           SET DA=BDMIEN

           SET DR=".04////"_BDMNOW_";.07///C"

 +4        DO ^DIE

 +5        KILL DIE,DR,DA

 +6        QUIT

 +7       ;

BDMSELFM.m