Routine: BDMDMAS

BDMDMAS ; IHS/CMI/LAB - print hs for dm patients with appts ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,8**;JUN 14, 2007;Build 53

 ;this routine will go through the Diabetes Register

 ;and then see if the patient has an appt, if so print health sum

 ;cmi/anch/maw 3/14/2006 modified BDMG to queue report into GUI holding file

EP ;EP - called from option interactive

 D EOJ

 W:$D(IOF) @IOF

 W !!,"This option will print a health summary for all patients who are on the ",!,"Diabetes Register that have an appointment on the date you specify.",!!

DATE ;get appt date

 S BDMDATE=""

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

 I $D(DIRUT) W !,"Goodbye" D EOJ Q

 S BDMDATE=Y

REGISTER ;get register name

 S BDMREG=""

 S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Official Diabetes Register: " D ^DIC

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

 S BDMREG=+Y

HSTYPE ;get hs type

 K DIC S DIC=9001015,DIC("A")="Select health summary type: ",DIC(0)="AEQM"

 S X="" I DUZ(2),$D(^APCCCTRL(DUZ(2),0))#2 S X=$P(^(0),U,3)

 I $D(^DISV(DUZ,"^APCHSCTL(")) S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)

 S:X="" X="ADULT REGULAR"

 S DIC("B")=X

 D ^DIC I Y>0 S BDMTYPE=+Y

ZIS ;

 S BDMTEMP=""

 S DIR(0)="S^P:PRINT the Output;B:BROWSE the Output on the Screen",DIR("A")="Output Type",DIR("B")="P" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EOJ Q

 S BDMTEMP=Y

 ;call to XBDBQUE

DEMO ;

 D DEMOCHK^BDMUTL(.BDMDEMO)

 I BDMDEMO=-1 G HSTYPE

 I BDMTEMP="B" D BROWSE,EOJ Q

 S XBRP="PRINT^BDMDMAS",XBRC="",XBRX="EOJ^BDMDMAS",XBNS="APCH;BDM"

 D ^XBDBQUE

 D EOJ

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^BDMDMAS"")"

 S XBRC="",XBRX="EOJ^BDMDMAS",XBIOP=0 D ^XBDBQUE

EOJ ;

 D ^XBFMK

 K DIC,DIR

 K APCHSTYP,BDMREG,BDMDATE,BDMTYPE

 D EN^XBVK("APCH")

PRINT ;EP - called from xbdbque

 K ^TMP($J,"BDMDMAS")

 S BDMSDAT=$$FMADD^XLFDT(BDMDATE,-1),BDMSDAT=BDMSDAT_".9999"

 ;go through register, if patient has appt then print hs

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

 .;check to see if patient has an appt

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

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

 .Q:$D(^TMP($J,"BDMDMAS",DFN))  ;already printed one for this pat

 .S ^TMP($J,"BDMDMAS",DFN)=""

 .S BDMDMY=BDMSDAT F  S BDMDMY=$O(^DPT(DFN,"S",BDMDMY)) Q:BDMDMY=""!($P(BDMDMY,".")>BDMDATE)  D

 ..I $P(^DPT(DFN,"S",BDMDMY,0),U,2)["C" Q  ;cancelled

 ..S APCHSPAT=DFN,APCHSTYP=BDMTYPE D EN^APCHS

..Q

.Q

QUEUE ;EP - called from queued option

 S BDMREG=$O(^ACM(41.1,"B","IHS DIABETES",0))

 I BDMREG="" K BDMREG Q

 S BDMTYPE=$O(^APCHSTYP("B","ADULT REGULAR",0))

 I BDMTYPE="" K BDMREG,BDMTYPE Q

 S BDMDATE=DT

 D PRINT

 D EOJ

BDMG(BDMREG,BDMDATE,BDMTYPE,BDMGIEN) ;EP - GUI DMS Entry Point

 ;cmi/anch/maw added 10/19/2004

 S BDMTYPE=$O(^APCHSCTL("B",BDMTYPE,0))

 ;create entry in fileman file to hold output

 N BDMOPT  ;maw

 S BDMOPT="Print Health Summary for DM Patients w/Appt"

 D NOW^%DTC

 S BDMNOW=$G(%)

 K DD,D0,DIC

 S BDMJOB=$J,BDMBTH=$P($H,",")

 S X=DUZ_"."_BDMBTH

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

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

 D FILE^DICN

 K DIADD,DLAYGO,DIC,DA

 I Y=-1 S BDMIEN=-1 Q

 S BDMIEN=+Y

 S BDMGIEN=BDMIEN  ;cmi/maw added

 D ^XBFMK

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

 ;D GUIEP for interactive testing

 S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDMAS",ZTDESC="GUI PRINT HS FOR DM" D ^%ZTLOAD

 D EOJ

GUIEP ;EP - called from taskman

 K ^TMP($J,"BDMDMAS")

 S IOM=80  ;cmi/maw added

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

 S X=0,C=0 F  S X=$O(^TMP($J,"BDMDMAS",X)) Q:X'=+X  S ^BDMGUI(BDMIEN,11,X,0)=^TMP($J,"BDMDMAS",X),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

BDMDMAS   ; IHS/CMI/LAB - print hs for dm patients with appts ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,8**;JUN 14, 2007;Build 53

 +2       ;

 +3       ;

 +4       ;this routine will go through the Diabetes Register

 +5       ;and then see if the patient has an appt, if so print health sum

 +6       ;

 +7       ;cmi/anch/maw 3/14/2006 modified BDMG to queue report into GUI holding file

 +8       ;

EP        ;EP - called from option interactive

 +1        DO EOJ

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This option will print a health summary for all patients who are on the ",!,"Diabetes Register that have an appointment on the date you specify.",!!

DATE      ;get appt date

 +1        SET BDMDATE=""

 +2        SET DIR(0)="D^::EF"

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

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               WRITE !,"Goodbye"

               DO EOJ

               QUIT

 +4        SET BDMDATE=Y

REGISTER  ;get register name

 +1        SET BDMREG=""

 +2        SET DIC="^ACM(41.1,"

           SET DIC(0)="AEMQ"

           SET DIC("A")="Enter the Official Diabetes Register: "

           DO ^DIC

 +3        IF Y=-1

               SET BDMREG=""

               WRITE !,"No Register Selected."

               GOTO DATE

 +4        SET BDMREG=+Y

HSTYPE    ;get hs type

 +1        KILL DIC

           SET DIC=9001015

           SET DIC("A")="Select health summary type: "

           SET DIC(0)="AEQM"

 +2        SET X=""

           IF DUZ(2)

               IF $DATA(^APCCCTRL(DUZ(2),0))#2

                   SET X=$PIECE(^(0),U,3)

 +3        IF $DATA(^DISV(DUZ,"^APCHSCTL("))

               SET Y=^("^APCHSCTL(")

               IF $DATA(^APCHSCTL(Y,0))

                   SET X=$PIECE(^(0),U,1)

 +4        IF X=""

               SET X="ADULT REGULAR"

 +5        SET DIC("B")=X

 +6        DO ^DIC

           IF Y>0

               SET BDMTYPE=+Y

ZIS       ;

 +1        SET BDMTEMP=""

 +2        SET DIR(0)="S^P:PRINT the Output;B:BROWSE the Output on the Screen"

           SET DIR("A")="Output Type"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               DO EOJ

               QUIT

 +4        SET BDMTEMP=Y

 +5       ;call to XBDBQUE

DEMO      ;

 +1        DO DEMOCHK^BDMUTL(.BDMDEMO)

 +2        IF BDMDEMO=-1

               GOTO HSTYPE

 +3        IF BDMTEMP="B"

               DO BROWSE

               DO EOJ

               QUIT

 +4        SET XBRP="PRINT^BDMDMAS"

           SET XBRC=""

           SET XBRX="EOJ^BDMDMAS"

           SET XBNS="APCH;BDM"

 +5        DO ^XBDBQUE

 +6        DO EOJ

 +7        QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""PRINT^BDMDMAS"")"

 +2        SET XBRC=""

           SET XBRX="EOJ^BDMDMAS"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

EOJ       ;

 +1        DO ^XBFMK

 +2        KILL DIC,DIR

 +3        KILL APCHSTYP,BDMREG,BDMDATE,BDMTYPE

 +4        DO EN^XBVK("APCH")

 +5        QUIT

 +6       ;

PRINT     ;EP - called from xbdbque

 +1        KILL ^TMP($JOB,"BDMDMAS")

 +2        SET BDMSDAT=$$FMADD^XLFDT(BDMDATE,-1)

           SET BDMSDAT=BDMSDAT_".9999"

 +3       ;go through register, if patient has appt then print hs

 +4        SET BDMDMX=0

FOR

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

               IF BDMDMX'=+BDMDMX

                   QUIT

               Begin DoDot:1

 +5       ;check to see if patient has an appt

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

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

                       QUIT

 +8       ;already printed one for this pat

                   IF $DATA(^TMP($JOB,"BDMDMAS",DFN))

                       QUIT

 +9                SET ^TMP($JOB,"BDMDMAS",DFN)=""

 +10               SET BDMDMY=BDMSDAT

FOR

                       SET BDMDMY=$ORDER(^DPT(DFN,"S",BDMDMY))

                       IF BDMDMY=""!($PIECE(BDMDMY,".")>BDMDATE)

                           QUIT

                       Begin DoDot:2

 +11      ;cancelled

                           IF $PIECE(^DPT(DFN,"S",BDMDMY,0),U,2)["C"

                               QUIT

 +12                       SET APCHSPAT=DFN

                           SET APCHSTYP=BDMTYPE

                           DO EN^APCHS

 +13                       QUIT

                       End DoDot:2

 +14               QUIT

               End DoDot:1

 +15       QUIT

QUEUE     ;EP - called from queued option

 +1        SET BDMREG=$ORDER(^ACM(41.1,"B","IHS DIABETES",0))

 +2        IF BDMREG=""

               KILL BDMREG

               QUIT

 +3        SET BDMTYPE=$ORDER(^APCHSTYP("B","ADULT REGULAR",0))

 +4        IF BDMTYPE=""

               KILL BDMREG,BDMTYPE

               QUIT

 +5        SET BDMDATE=DT

 +6        DO PRINT

 +7        DO EOJ

 +8        QUIT

 +9       ;

BDMG(BDMREG,BDMDATE,BDMTYPE,BDMGIEN) ;EP - GUI DMS Entry Point

 +1       ;cmi/anch/maw added 10/19/2004

 +2        SET BDMTYPE=$ORDER(^APCHSCTL("B",BDMTYPE,0))

 +3       ;create entry in fileman file to hold output

 +4       ;maw

           NEW BDMOPT

 +5        SET BDMOPT="Print Health Summary for DM Patients w/Appt"

 +6        DO NOW^%DTC

 +7        SET BDMNOW=$GET(%)

 +8        KILL DD,D0,DIC

 +9        SET BDMJOB=$JOB

           SET BDMBTH=$PIECE($HOROLOG,",")

 +10       SET X=DUZ_"."_BDMBTH

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

 +12       SET DIC="^BDMGUI("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9003201.4

 +13       DO FILE^DICN

 +14       KILL DIADD,DLAYGO,DIC,DA

 +15       IF Y=-1

               SET BDMIEN=-1

               QUIT

 +16       SET BDMIEN=+Y

 +17      ;cmi/maw added

           SET BDMGIEN=BDMIEN

 +18       DO ^XBFMK

 +19       KILL ZTSAVE

           SET ZTSAVE("*")=""

 +20      ;D GUIEP for interactive testing

 +21       SET ZTIO=""

           SET ZTDTH=$$NOW^XLFDT

           SET ZTRTN="GUIEP^BDMDMAS"

           SET ZTDESC="GUI PRINT HS FOR DM"

           DO ^%ZTLOAD

 +22       DO EOJ

 +23       QUIT

GUIEP     ;EP - called from taskman

 +1        KILL ^TMP($JOB,"BDMDMAS")

 +2       ;cmi/maw added

           SET IOM=80

 +3        DO GUIR^XBLM("PRINT^BDMDMAS","^TMP($J,""BDMDMAS"",")

 +4        SET X=0

           SET C=0

FOR

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

               IF X'=+X

                   QUIT

               SET ^BDMGUI(BDMIEN,11,X,0)=^TMP($JOB,"BDMDMAS",X)

               SET C=C+1

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

 +6        SET DA=BDMIEN

           SET DIK="^BDMGUI("

           DO IX1^DIK

 +7        DO ENDLOG

 +8        SET ZTREQ="@"

 +9        QUIT

 +10      ;

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       ;

BDMDMAS.m