Routine: APCLDMAS

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

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;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 APCLDATE=""

 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 APCLDATE=Y

REGISTER ;get register name

 S APCLREG=""

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

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

 S APCLREG=+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 APCLTYPE=+Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G HSTYPE

 S XBRP="PRINT^APCLDMAS",XBRC="",XBRX="EOJ^APCLDMAS",XBNS="APCH;APCL"

 D ^XBDBQUE

EOJ ;

 D ^XBFMK

 K DIC,DIR

 K APCHSTYP,APCLREG,APCLDATE,APCLTYPE

 D EN^XBVK("APCH")

PRINT ;EP - called from xbdbque

 K ^TMP($J,"APCLDMAS")

 S APCLSDAT=$$FMADD^XLFDT(APCLDATE,-1),APCLSDAT=APCLSDAT_".9999"

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

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

 .;check to see if patient has an appt

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

 .Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))

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

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

 .S APCLDMY=APCLSDAT F  S APCLDMY=$O(^DPT(DFN,"S",APCLDMY)) Q:APCLDMY=""!($P(APCLDMY,".")>APCLDATE)  D

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

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

..Q

.Q

QUEUE ;EP - called from queued option

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

 I APCLREG="" K APCLREG Q

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

 I APCLTYPE="" K APCLREG,APCLTYPE Q

 S APCLDATE=DT

 D PRINT

 D EOJ

BDMG(APCLREG,APCLDATE,APCLTYPE,BDMGIEN) ;EP - GUI DMS Entry Point

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

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

 ;create entry in fileman file to hold output

 N APCLOPT  ;maw

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

 D NOW^%DTC

 S APCLNOW=$G(%)

 K DD,D0,DIC

 S APCLJOB=$J,APCLBTH=$P($H,",")

 S X=APCLJOB_"."_APCLBTH

 S DIC("DR")=".02////"_DUZ_";.03////"_APCLNOW_";.05////"_$G(APCLPREP)_";.06///"_$G(APCLOPT)_";.07///R"

 S DIC="^APCLGUIR(",DIC(0)="L",DIADD=1,DLAYGO=9001004.4

 D FILE^DICN

 K DIADD,DLAYGO,DIC,DA

 I Y=-1 S APCLIEN=-1 Q

 S APCLIEN=+Y

 S BDMGIEN=APCLIEN  ;cmi/maw added

 D ^XBFMK

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

 ;D GUIEP for interactive testing

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

 D EOJ

GUIEP ;EP - called from taskman

 K ^TMP($J,"APCLDMAS")

 S IOM=80  ;cmi/maw added

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

 S X=0,C=0 F  S X=$O(^TMP($J,"APCLDMAS",X)) Q:X'=+X  S ^APCLGUIR(APCLIEN,11,X,0)=^TMP($J,"APCLDMAS",X),C=C+1

 S ^APCLGUIR(APCLIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"

 S DA=APCLIEN,DIK="^APCLGUIR(" D IX1^DIK

 D ENDLOG

 S ZTREQ="@"

ENDLOG ;-- write the end of the log

 D NOW^%DTC

 S APCLNOW=$G(%)

 S DIE="^APCLGUIR(",DA=APCLIEN,DR=".04////"_APCLNOW_";.07///C"

 D ^DIE

 K DIE,DR,DA

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

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +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 APCLDATE=""

 +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 APCLDATE=Y

REGISTER  ;get register name

 +1        SET APCLREG=""

 +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 APCLREG=""

               WRITE !,"No Register Selected."

               GOTO DATE

 +4        SET APCLREG=+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 APCLTYPE=+Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO HSTYPE

 +3        SET XBRP="PRINT^APCLDMAS"

           SET XBRC=""

           SET XBRX="EOJ^APCLDMAS"

           SET XBNS="APCH;APCL"

 +4        DO ^XBDBQUE

 +5        QUIT

EOJ       ;

 +1        DO ^XBFMK

 +2        KILL DIC,DIR

 +3        KILL APCHSTYP,APCLREG,APCLDATE,APCLTYPE

 +4        DO EN^XBVK("APCH")

 +5        QUIT

 +6       ;

PRINT     ;EP - called from xbdbque

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

 +2        SET APCLSDAT=$$FMADD^XLFDT(APCLDATE,-1)

           SET APCLSDAT=APCLSDAT_".9999"

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

 +4        SET APCLDMX=0

FOR

               SET APCLDMX=$ORDER(^ACM(41,"B",APCLREG,APCLDMX))

               IF APCLDMX'=+APCLDMX

                   QUIT

               Begin DoDot:1

 +5       ;check to see if patient has an appt

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

 +7                IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))

                       QUIT

 +8       ;already printed one for this pat

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

                       QUIT

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

 +10               SET APCLDMY=APCLSDAT

FOR

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

                       IF APCLDMY=""!($PIECE(APCLDMY,".")>APCLDATE)

                           QUIT

                       Begin DoDot:2

 +11      ;cancelled

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

                               QUIT

 +12                       SET APCHSPAT=DFN

                           SET APCHSTYP=APCLTYPE

                           DO EN^APCHS

 +13                       QUIT

                       End DoDot:2

 +14               QUIT

               End DoDot:1

 +15       QUIT

QUEUE     ;EP - called from queued option

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

 +2        IF APCLREG=""

               KILL APCLREG

               QUIT

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

 +4        IF APCLTYPE=""

               KILL APCLREG,APCLTYPE

               QUIT

 +5        SET APCLDATE=DT

 +6        DO PRINT

 +7        DO EOJ

 +8        QUIT

 +9       ;

BDMG(APCLREG,APCLDATE,APCLTYPE,BDMGIEN) ;EP - GUI DMS Entry Point

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

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

 +3       ;create entry in fileman file to hold output

 +4       ;maw

           NEW APCLOPT

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

 +6        DO NOW^%DTC

 +7        SET APCLNOW=$GET(%)

 +8        KILL DD,D0,DIC

 +9        SET APCLJOB=$JOB

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

 +10       SET X=APCLJOB_"."_APCLBTH

 +11       SET DIC("DR")=".02////"_DUZ_";.03////"_APCLNOW_";.05////"_$GET(APCLPREP)_";.06///"_$GET(APCLOPT)_";.07///R"

 +12       SET DIC="^APCLGUIR("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9001004.4

 +13       DO FILE^DICN

 +14       KILL DIADD,DLAYGO,DIC,DA

 +15       IF Y=-1

               SET APCLIEN=-1

               QUIT

 +16       SET APCLIEN=+Y

 +17      ;cmi/maw added

           SET BDMGIEN=APCLIEN

 +18       DO ^XBFMK

 +19       KILL ZTSAVE

           SET ZTSAVE("*")=""

 +20      ;D GUIEP for interactive testing

 +21       SET ZTIO=""

           SET ZTDTH=$$NOW^XLFDT

           SET ZTRTN="GUIEP^APCLDMAS"

           SET ZTDESC="GUI PRINT HS FOR DM"

           DO ^%ZTLOAD

 +22       DO EOJ

 +23       QUIT

GUIEP     ;EP - called from taskman

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

 +2       ;cmi/maw added

           SET IOM=80

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

 +4        SET X=0

           SET C=0

FOR

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

               IF X'=+X

                   QUIT

               SET ^APCLGUIR(APCLIEN,11,X,0)=^TMP($JOB,"APCLDMAS",X)

               SET C=C+1

 +5        SET ^APCLGUIR(APCLIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"

 +6        SET DA=APCLIEN

           SET DIK="^APCLGUIR("

           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 APCLNOW=$GET(%)

 +3        SET DIE="^APCLGUIR("

           SET DA=APCLIEN

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

 +4        DO ^DIE

 +5        KILL DIE,DR,DA

 +6        QUIT

 +7       ;

APCLDMAS.m