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
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDMAS"")"
S XBRC="",XBRX="EOJ^BDMDMAS",XBIOP=0 D ^XBDBQUE
Q
EOJ ;
D ^XBFMK
K DIC,DIR
K APCHSTYP,BDMREG,BDMDATE,BDMTYPE
D EN^XBVK("APCH")
Q
;
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
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
Q
;
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
Q
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="@"
Q
;
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
Q
;
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 ;
