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
Q
EOJ ;
D ^XBFMK
K DIC,DIR
K APCHSTYP,APCLREG,APCLDATE,APCLTYPE
D EN^XBVK("APCH")
Q
;
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
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
Q
;
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
Q
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="@"
Q
;
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
Q
;
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 ;
