BDMDMAP ; IHS/CMI/LAB - print hs for dm patients with appts ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,8,10**;JUN 14, 2007;Build 12
;
;
;this routine will go through the Diabetes Register
;and then see if the patient has an appt, if so print health sum
;
EP ;EP - called from option interactive
D EOJ
W:$D(IOF) @IOF
W !!,"This option will print a list of all patients on a register"
W !,"e.g. Diabetes Register) who have an appointment in a date range"
W !,"in any clinic or in a selected set of clinics.",!!
W !!,"You will be asked to enter the name of the register, the date range of the"
W !,"appointments and the clinic names if selecting a set of clinics.",!
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
DATES K BDMED,BDMBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Appointment Date"
D ^DIR G:Y<1 REGISTER S BDMBD=Y
K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Appointment Date"
D ^DIR G:Y<1 REGISTER S BDMED=Y
;
I BDMED<BDMBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
S BDMSD=$$FMADD^XLFDT(BDMBD,-1)_".9999"
;
CLIN ;
S BDMCLN=""
S DIR(0)="S^A:ANY Clinic;S:One or more selected Clinics",DIR("A")="Include patients with Appointments to",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) DATES
S BDMCLN=Y
I BDMCLN="A" K BDMCLN G ZIS
;get which clinics
K BDMCLN
CLIN1 ;
W ! S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC: "
S DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC K DIC
I Y=-1,'$D(BDMCLN) G CLIN
I X="^" G CLIN
I Y="",$D(BDMCLN) G ZIS
I Y=-1,$D(BDMCLN) G ZIS
I X="",'$D(BDMCLN) G CLIN
S BDMCLN(+Y)=""
G CLIN1
ZIS ;
S BDMTEMP=""
S DIR(0)="S^P:PRINT the List;B:BROWSE the List 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 D EOJ Q
I BDMTEMP="B" D BROWSE,EOJ Q
S XBRP="PRINT^BDMDMAP",XBRC="PROC^BDMDMAP",XBRX="EOJ^BDMDMAP",XBNS="BDM"
D ^XBDBQUE
D EOJ
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDMAP"")"
S XBRC="PROC^BDMDMAP",XBRX="EOJ^BDMDMAP",XBIOP=0 D ^XBDBQUE
Q
EOJ ;
D ^XBFMK
K DIC,DIR
I '$D(BDMGUI) D EN^XBVK("BDM")
Q
;
TEST ;
D BDMG(1,3040101,3041231,13)
Q
BDMG(BDMREG,BDMBD,BDMED,BDMCLN) ;EP - GUI DMS Entry Point
;cmi/anch/maw added 10/19/2004
S BDMSD=$$FMADD^XLFDT(BDMBD,-1)_".9999"
S BDMGUI=1
N BDMOPT,BDMNOW,BDMIEN ;maw
S BDMOPT="List Patients on a Register w/an Appointment"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,D0,DIC
S X=DUZ_$$NOW^XLFDT
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.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^BDMDMAP",ZTDESC="GUI DM REG APPT" D ^%ZTLOAD
D EOJ
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDMAP")
S IOM=80
D GUIR^XBLM("PRINT^BDMDMAP","^TMP($J,""BDMDMAP"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDMAP",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDMAP",X)
.;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
.S ^BDMGUI(BDMIEN,11,X,0)=BDMDATA,C=C+1
S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
K ^TMP($J,"BDMDMAP")
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
;
PROC ;
S BDMJ=$J,BDMH=$H
S ^XTMP("BDMDMAP",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH APPT"
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))
.S BDMDMY=BDMSD F S BDMDMY=$O(^DPT(DFN,"S",BDMDMY)) Q:BDMDMY=""!($P(BDMDMY,".")>BDMED) D
..I $P(^DPT(DFN,"S",BDMDMY,0),U,2)["C" Q ;cancelled
..I $D(BDMCLN) S X=$P(^DPT(DFN,"S",BDMDMY,0),U) I '$D(BDMCLN(X)) Q ;not a clinic of interest
..S ^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMDMY,$P(^DPT(DFN,"S",BDMDMY,0),U))=""
..Q
.Q
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("BDMDMAP",BDMJ,BDMH),BDMJ,BDMH
Q
;
PRINT ;EP - called from xbdbque
S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
K BDMQ S BDMPG=0 D HEADER
I '$D(^XTMP("BDMDMAP",BDMJ,BDMH)) W !!,"NO DATA TO REPORT",! G DONE
S DFN=0 F S DFN=$O(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN)) Q:DFN'=+DFN!($D(BDMQ)) D
.S BDMD=0 F S BDMD=$O(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMD)) Q:BDMD'=+BDMD!($D(BDMQ)) D
..S BDMC=0 F S BDMC=$O(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMD,BDMC)) Q:BDMC'=+BDMC!($D(BDMQ)) D
...I $Y>(BDMIOSL-4) D HEADER Q:$D(BDMQ)
...W !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,25),?38,$E($P(^SC(BDMC,0),U),1,20),?59,$$FMTE^XLFDT($P(BDMD,".")),?72,$P($$FMTE^XLFDT(BDMD,"2P")," ",2)
D DONE
Q
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
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 WITH AN APPOINTMENT",80),!
S X="Appointment Dates: "_$$FMTE^XLFDT(BDMBD)_" to "_$$FMTE^XLFDT(BDMED) W $$CTR(X,80),!
W $$CTR("CLINICS: "_$S($D(BDMCLN):"USER SELECTED",1:"ANY"),80),!
W !,"HRN",?7,"PATIENT NAME",?38,"CLINIC NAME",?59,"DATE",?72,"TIME"
W !,$TR($J("",80)," ","-")
Q
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
Q
;----------
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
Q
BDMDMAP ; IHS/CMI/LAB - print hs for dm patients with appts ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,8,10**;JUN 14, 2007;Build 12
+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 ;
EP ;EP - called from option interactive
+1 DO EOJ
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"This option will print a list of all patients on a register"
+4 WRITE !,"e.g. Diabetes Register) who have an appointment in a date range"
+5 WRITE !,"in any clinic or in a selected set of clinics.",!!
+6 WRITE !!,"You will be asked to enter the name of the register, the date range of the"
+7 WRITE !,"appointments and the clinic names if selecting a set of clinics.",!
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
DATES KILL BDMED,BDMBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Appointment Date"
+2 DO ^DIR
IF Y<1
GOTO REGISTER
SET BDMBD=Y
+3 KILL DIR
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Ending Appointment Date"
+4 DO ^DIR
IF Y<1
GOTO REGISTER
SET BDMED=Y
+5 ;
+6 IF BDMED<BDMBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 SET BDMSD=$$FMADD^XLFDT(BDMBD,-1)_".9999"
+9 ;
CLIN ;
+1 SET BDMCLN=""
+2 SET DIR(0)="S^A:ANY Clinic;S:One or more selected Clinics"
SET DIR("A")="Include patients with Appointments to"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO DATES
+4 SET BDMCLN=Y
+5 IF BDMCLN="A"
KILL BDMCLN
GOTO ZIS
+6 ;get which clinics
+7 KILL BDMCLN
CLIN1 ;
+1 WRITE !
SET DIC="^SC("
SET DIC(0)="AEMZQ"
SET DIC("A")="Select CLINIC: "
+2 SET DIC("S")="I $P(^(0),U,3)=""C"""
DO ^DIC
KILL DIC
+3 IF Y=-1
IF '$DATA(BDMCLN)
GOTO CLIN
+4 IF X="^"
GOTO CLIN
+5 IF Y=""
IF $DATA(BDMCLN)
GOTO ZIS
+6 IF Y=-1
IF $DATA(BDMCLN)
GOTO ZIS
+7 IF X=""
IF '$DATA(BDMCLN)
GOTO CLIN
+8 SET BDMCLN(+Y)=""
+9 GOTO CLIN1
ZIS ;
+1 SET BDMTEMP=""
+2 SET DIR(0)="S^P:PRINT the List;B:BROWSE the List 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
DO EOJ
QUIT
+3 IF BDMTEMP="B"
DO BROWSE
DO EOJ
QUIT
+4 SET XBRP="PRINT^BDMDMAP"
SET XBRC="PROC^BDMDMAP"
SET XBRX="EOJ^BDMDMAP"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EOJ
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDMAP"")"
+2 SET XBRC="PROC^BDMDMAP"
SET XBRX="EOJ^BDMDMAP"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EOJ ;
+1 DO ^XBFMK
+2 KILL DIC,DIR
+3 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+4 QUIT
+5 ;
TEST ;
+1 DO BDMG(1,3040101,3041231,13)
+2 QUIT
BDMG(BDMREG,BDMBD,BDMED,BDMCLN) ;EP - GUI DMS Entry Point
+1 ;cmi/anch/maw added 10/19/2004
+2 SET BDMSD=$$FMADD^XLFDT(BDMBD,-1)_".9999"
+3 SET BDMGUI=1
+4 ;maw
NEW BDMOPT,BDMNOW,BDMIEN
+5 SET BDMOPT="List Patients on a Register w/an Appointment"
+6 DO NOW^%DTC
+7 SET BDMNOW=$GET(%)
+8 KILL DD,D0,DIC
+9 SET X=DUZ_$$NOW^XLFDT
+10 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$GET(BDMOPT)_";.07////R"
+11 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+12 DO FILE^DICN
+13 KILL DIADD,DLAYGO,DIC,DA
+14 IF Y=-1
SET BDMIEN=-1
QUIT
+15 SET BDMIEN=+Y
+16 ;cmi/maw added
SET BDMGIEN=BDMIEN
+17 DO ^XBFMK
+18 KILL ZTSAVE
SET ZTSAVE("*")=""
+19 ;D GUIEP for interactive testing
+20 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDMAP"
SET ZTDESC="GUI DM REG APPT"
DO ^%ZTLOAD
+21 DO EOJ
+22 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDMAP")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDMAP","^TMP($J,""BDMDMAP"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDMAP",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDMAP",X)
+7 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+8 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+9 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+10 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+11 DO ENDLOG
+12 KILL ^TMP($JOB,"BDMDMAP")
+13 SET ZTREQ="@"
+14 QUIT
+15 ;
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 ;
PROC ;
+1 SET BDMJ=$JOB
SET BDMH=$HOROLOG
+2 SET ^XTMP("BDMDMAP",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH APPT"
+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 an appt
+5 SET DFN=$PIECE(^ACM(41,BDMDMX,0),U,2)
+6 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+7 SET BDMDMY=BDMSD
FOR
SET BDMDMY=$ORDER(^DPT(DFN,"S",BDMDMY))
IF BDMDMY=""!($PIECE(BDMDMY,".")>BDMED)
QUIT
Begin DoDot:2
+8 ;cancelled
IF $PIECE(^DPT(DFN,"S",BDMDMY,0),U,2)["C"
QUIT
+9 ;not a clinic of interest
IF $DATA(BDMCLN)
SET X=$PIECE(^DPT(DFN,"S",BDMDMY,0),U)
IF '$DATA(BDMCLN(X))
QUIT
+10 SET ^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMDMY,$PIECE(^DPT(DFN,"S",BDMDMY,0),U))=""
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 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("BDMDMAP",BDMJ,BDMH),BDMJ,BDMH
+5 QUIT
+6 ;
PRINT ;EP - called from xbdbque
+1 SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+2 KILL BDMQ
SET BDMPG=0
DO HEADER
+3 IF '$DATA(^XTMP("BDMDMAP",BDMJ,BDMH))
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN))
IF DFN'=+DFN!($DATA(BDMQ))
QUIT
Begin DoDot:1
+5 SET BDMD=0
FOR
SET BDMD=$ORDER(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMD))
IF BDMD'=+BDMD!($DATA(BDMQ))
QUIT
Begin DoDot:2
+6 SET BDMC=0
FOR
SET BDMC=$ORDER(^XTMP("BDMDMAP",BDMJ,BDMH,"APPTS",DFN,BDMD,BDMC))
IF BDMC'=+BDMC!($DATA(BDMQ))
QUIT
Begin DoDot:3
+7 IF $Y>(BDMIOSL-4)
DO HEADER
IF $DATA(BDMQ)
QUIT
+8 WRITE !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$EXTRACT($PIECE(^DPT(DFN,0),U),1,25),?38,$EXTRACT($PIECE(^SC(BDMC,0),U),1,20),?59,$$FMTE^XLFDT($PIECE(BDMD,".")),?72,$PIECE($$FMTE^XLFDT(BDMD,"2P")," ",2)
End DoDot:3
End DoDot:2
End DoDot:1
+9 DO DONE
+10 QUIT
+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
+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 WITH AN APPOINTMENT",80),!
+5 SET X="Appointment Dates: "_$$FMTE^XLFDT(BDMBD)_" to "_$$FMTE^XLFDT(BDMED)
WRITE $$CTR(X,80),!
+6 WRITE $$CTR("CLINICS: "_$SELECT($DATA(BDMCLN):"USER SELECTED",1:"ANY"),80),!
+7 WRITE !,"HRN",?7,"PATIENT NAME",?38,"CLINIC NAME",?59,"DATE",?72,"TIME"
+8 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+9 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
