BDMFMENU ; IHS/CMI/LAB - CONTROL HEADINGS AND MENUS ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
;;ROUTINE TO CONTROL HEADINGS AND MENUS
TITLE ;EP;TO DISPLAY TITLE
S BDMFINSS=""
S IOP="HOME"
D ^%ZIS
D HOME
D HEAD
EXIT K BDMX,BDMZ,BDMTRM
I $D(BDMY),BDMY]"" S BDMY=BDMY_$S($G(BDMREGNM)]"":" - "_BDMREGNM,1:"") W !?80-$L(BDMY)/2,BDMY
D ^BDMFEXIT
Q
HEAD ;EP;TO DISPLAY HEADER
W @IOF
HEAD1 F BDMJ=0:1:4 D H1
D HDVS
I DUZ D
.S BDMX=$P(^VA(200,DUZ,0),U)
.S BDMX=$P($P(BDMX,",",2)," ")_" "_$P(BDMX,",")
.S BDMX="CURRENT USER: "_BDMX
.;W !?80-$L(BDMX)\2,BDMX
D:BDMON=""!(BDMOF="") RV
Q
H1 S BDMX=$T(TEXT+BDMJ),BDMX=$P(BDMX,";;",2)
W !?80-$L(BDMX)\2,BDMX
Q
HDVS I $D(DUZ(2))#2,DUZ(2) S:$D(^DIC(4,DUZ(2),0)) BDMX=$P(^(0),U)
I $D(^DIC(9.4,"C","BDM")) D
.S BDMZ=$O(^DIC(9.4,"C","BDM",0))
.S BDMZ=$P(^DIC(9.4,BDMZ,"VERSION"),U)
.S BDMZ="VERSION 2.0 (Patch 12)"
I $E(IOST,1,2)="C-" W:$D(BDMZ) !?80-$L(BDMZ)\2,BDMZ
W:$D(BDMX) !?80-$L(BDMX)\2,BDMX
Q
RM ;EP
S BDMY="REGISTER MAINTENANCE"
D TITLE
Q
AS ;EP
S BDMY="AUDIT SETUP"
D TITLE
Q
ASPR ;EP
S BDMY="PRIOR YEARS AUDIT SETUP"
D TITLE
Q
AR ;EP
S BDMY="AUDIT REPORTING"
D TITLE
Q
AT ;EP
S BDMY="AUDIT TOOLS"
D TITLE
Q
AS19 ;
S BDMY="2019 DIABETES AUDIT SETUP"
D TITLE
Q
AS18 ;
S BDMY="2018 DIABETES AUDIT SETUP"
D TITLE
Q
AS17 ;
S BDMY="2017 DIABETES AUDIT SETUP"
D TITLE
Q
AS16 ;
S BDMY="2016 DIABETES AUDIT SETUP"
D TITLE
Q
MM ;EP
S BDMY="MAIN MENU"
D TITLE
Q
RP ;EP
S BDMY="REGISTER REPORTS MENU"
D TITLE
Q
DA ;EP
S BDMY="IHS DIABETES QA AUDIT MENU"
D TITLE
Q
LM ;EP
S BDMY="LETTER MANAGEMENT"
D TITLE
Q
PDM ;EP
S BDMY="PREDIABETES AUDIT"
D TITLE
Q
RMAN ;EP
S BDMY="REGISTER MANAGEMENT"
D TITLE
Q
HOME ;EP;TO SET TERMINAL CONTROL VARIABLES
S BDMTRM=^%ZIS(2,IOST(0),5)
S BDMXY=$G(^%ZIS(2,IOST(0),"XY"))
S BDMON=$P(BDMTRM,U,4)
S BDMOF=$P(BDMTRM,U,5)
D:BDMON=""!(BDMOF="") RV
D ENS^%ZISS
Q
CLEAN ;EP;TO KILL SELECTD VARIABLES
K BDMON,BDMOF,BDMZ,BDMY,BDMTRM,BDMFINSS,BDMPPO,BDMPTX,BDMREV,BDMRR,BDMSOF,BDMTRN,BDMBOX
Q
RV ;WARNING MESSAGE WHEN REVERSE VIDEO NOT DEFINED
W @IOF
W !?10,"WARNING WARNING WARNING WARNING WARNING"
W *7,*7
W !!,"Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the ARMS"
W !,"system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined."
W !,"This is the responsibility of the AREA OFFICE computer site manager."
W !!,"Please contact this individual for assistance. Let him/her know that you"
W !,"are logged in on device NO.: ",$I
D P1
Q
B1 ;EP;TO TURN BLINK ON
W:$D(IOBON)&$D(IOBOFF) IOBON
Q
B2 ;EP;TO TURN BLINK OFF
W:$D(IOBOFF) IOBOFF
Q
U1 ;EP;TO TURN UNDERLINE ON
W:$D(IOUON)&$D(IOUOFF) IOUON
Q
U2 ;EP;TO TURN UNDERLINE OFF
W:$D(IOUOFF) IOUOFF
Q
DASH(Z) ;EP;TO WRITE LINE OF DASHES
S:'$G(Z) Z=80
W !
W $$DASH1(Z)
Q ""
DASH1(Z) ;EP;TO WRITE DASHES WITHOUT LINE FEED
S:'$G(Z) Z=80
N I
F I=1:1:Z W "-"
Q ""
WARNING ;EP;TO DISPLAY WARNING MESSAGE
D B1
N ACRI
W !!
F ACRI=1:1:6 W ?$X+5,"WARNING"
D B2
Q
PAUSE ;EP;
Q:$E(IOST,1,2)'="C-"
K DIR
P1 ;EP;
N X,Y,Z
W !
S DIR(0)="EOA"
S DIR("A")="Press RETURN to continue or '^' to exit. "
D DIR^BDMFDIC
S:$G(X)["^" DN=0,BDMOUT=""
Q
TEXT ;;THIS SYSTEM CONTAINS CONFIDENTIAL PATIENT INFORMATION COVERED
;;BY THE PRIVACY ACT. UNAUTHORIZED USE OF THIS DATA IS ILLEGAL
;;****************************************************
;;** DIABETES MANAGEMENT SYSTEM **
;;****************************************************
BDMFMENU ; IHS/CMI/LAB - CONTROL HEADINGS AND MENUS ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
+2 ;;ROUTINE TO CONTROL HEADINGS AND MENUS
TITLE ;EP;TO DISPLAY TITLE
+1 SET BDMFINSS=""
+2 SET IOP="HOME"
+3 DO ^%ZIS
+4 DO HOME
+5 DO HEAD
EXIT KILL BDMX,BDMZ,BDMTRM
+1 IF $DATA(BDMY)
IF BDMY]""
SET BDMY=BDMY_$SELECT($GET(BDMREGNM)]"":" - "_BDMREGNM,1:"")
WRITE !?80-$LENGTH(BDMY)/2,BDMY
+2 DO ^BDMFEXIT
+3 QUIT
HEAD ;EP;TO DISPLAY HEADER
+1 WRITE @IOF
HEAD1 FOR BDMJ=0:1:4
DO H1
+1 DO HDVS
+2 IF DUZ
Begin DoDot:1
+3 SET BDMX=$PIECE(^VA(200,DUZ,0),U)
+4 SET BDMX=$PIECE($PIECE(BDMX,",",2)," ")_" "_$PIECE(BDMX,",")
+5 SET BDMX="CURRENT USER: "_BDMX
+6 ;W !?80-$L(BDMX)\2,BDMX
End DoDot:1
+7 IF BDMON=""!(BDMOF="")
DO RV
+8 QUIT
H1 SET BDMX=$TEXT(TEXT+BDMJ)
SET BDMX=$PIECE(BDMX,";;",2)
+1 WRITE !?80-$LENGTH(BDMX)\2,BDMX
+2 QUIT
HDVS IF $DATA(DUZ(2))#2
IF DUZ(2)
IF $DATA(^DIC(4,DUZ(2),0))
SET BDMX=$PIECE(^(0),U)
+1 IF $DATA(^DIC(9.4,"C","BDM"))
Begin DoDot:1
+2 SET BDMZ=$ORDER(^DIC(9.4,"C","BDM",0))
+3 SET BDMZ=$PIECE(^DIC(9.4,BDMZ,"VERSION"),U)
+4 SET BDMZ="VERSION 2.0 (Patch 12)"
End DoDot:1
+5 IF $EXTRACT(IOST,1,2)="C-"
IF $DATA(BDMZ)
WRITE !?80-$LENGTH(BDMZ)\2,BDMZ
+6 IF $DATA(BDMX)
WRITE !?80-$LENGTH(BDMX)\2,BDMX
+7 QUIT
RM ;EP
+1 SET BDMY="REGISTER MAINTENANCE"
+2 DO TITLE
+3 QUIT
AS ;EP
+1 SET BDMY="AUDIT SETUP"
+2 DO TITLE
+3 QUIT
ASPR ;EP
+1 SET BDMY="PRIOR YEARS AUDIT SETUP"
+2 DO TITLE
+3 QUIT
AR ;EP
+1 SET BDMY="AUDIT REPORTING"
+2 DO TITLE
+3 QUIT
AT ;EP
+1 SET BDMY="AUDIT TOOLS"
+2 DO TITLE
+3 QUIT
AS19 ;
+1 SET BDMY="2019 DIABETES AUDIT SETUP"
+2 DO TITLE
+3 QUIT
AS18 ;
+1 SET BDMY="2018 DIABETES AUDIT SETUP"
+2 DO TITLE
+3 QUIT
AS17 ;
+1 SET BDMY="2017 DIABETES AUDIT SETUP"
+2 DO TITLE
+3 QUIT
AS16 ;
+1 SET BDMY="2016 DIABETES AUDIT SETUP"
+2 DO TITLE
+3 QUIT
MM ;EP
+1 SET BDMY="MAIN MENU"
+2 DO TITLE
+3 QUIT
RP ;EP
+1 SET BDMY="REGISTER REPORTS MENU"
+2 DO TITLE
+3 QUIT
DA ;EP
+1 SET BDMY="IHS DIABETES QA AUDIT MENU"
+2 DO TITLE
+3 QUIT
LM ;EP
+1 SET BDMY="LETTER MANAGEMENT"
+2 DO TITLE
+3 QUIT
PDM ;EP
+1 SET BDMY="PREDIABETES AUDIT"
+2 DO TITLE
+3 QUIT
RMAN ;EP
+1 SET BDMY="REGISTER MANAGEMENT"
+2 DO TITLE
+3 QUIT
HOME ;EP;TO SET TERMINAL CONTROL VARIABLES
+1 SET BDMTRM=^%ZIS(2,IOST(0),5)
+2 SET BDMXY=$GET(^%ZIS(2,IOST(0),"XY"))
+3 SET BDMON=$PIECE(BDMTRM,U,4)
+4 SET BDMOF=$PIECE(BDMTRM,U,5)
+5 IF BDMON=""!(BDMOF="")
DO RV
+6 DO ENS^%ZISS
+7 QUIT
CLEAN ;EP;TO KILL SELECTD VARIABLES
+1 KILL BDMON,BDMOF,BDMZ,BDMY,BDMTRM,BDMFINSS,BDMPPO,BDMPTX,BDMREV,BDMRR,BDMSOF,BDMTRN,BDMBOX
+2 QUIT
RV ;WARNING MESSAGE WHEN REVERSE VIDEO NOT DEFINED
+1 WRITE @IOF
+2 WRITE !?10,"WARNING WARNING WARNING WARNING WARNING"
+3 WRITE *7,*7
+4 WRITE !!,"Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the ARMS"
+5 WRITE !,"system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined."
+6 WRITE !,"This is the responsibility of the AREA OFFICE computer site manager."
+7 WRITE !!,"Please contact this individual for assistance. Let him/her know that you"
+8 WRITE !,"are logged in on device NO.: ",$IO
+9 DO P1
+10 QUIT
B1 ;EP;TO TURN BLINK ON
+1 IF $DATA(IOBON)&$DATA(IOBOFF)
WRITE IOBON
+2 QUIT
B2 ;EP;TO TURN BLINK OFF
+1 IF $DATA(IOBOFF)
WRITE IOBOFF
+2 QUIT
U1 ;EP;TO TURN UNDERLINE ON
+1 IF $DATA(IOUON)&$DATA(IOUOFF)
WRITE IOUON
+2 QUIT
U2 ;EP;TO TURN UNDERLINE OFF
+1 IF $DATA(IOUOFF)
WRITE IOUOFF
+2 QUIT
DASH(Z) ;EP;TO WRITE LINE OF DASHES
+1 IF '$GET(Z)
SET Z=80
+2 WRITE !
+3 WRITE $$DASH1(Z)
+4 QUIT ""
DASH1(Z) ;EP;TO WRITE DASHES WITHOUT LINE FEED
+1 IF '$GET(Z)
SET Z=80
+2 NEW I
+3 FOR I=1:1:Z
WRITE "-"
+4 QUIT ""
WARNING ;EP;TO DISPLAY WARNING MESSAGE
+1 DO B1
+2 NEW ACRI
+3 WRITE !!
+4 FOR ACRI=1:1:6
WRITE ?$X+5,"WARNING"
+5 DO B2
+6 QUIT
PAUSE ;EP;
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 KILL DIR
P1 ;EP;
+1 NEW X,Y,Z
+2 WRITE !
+3 SET DIR(0)="EOA"
+4 SET DIR("A")="Press RETURN to continue or '^' to exit. "
+5 DO DIR^BDMFDIC
+6 IF $GET(X)["^"
SET DN=0
SET BDMOUT=""
+7 QUIT
TEXT ;;THIS SYSTEM CONTAINS CONFIDENTIAL PATIENT INFORMATION COVERED
+1 ;;BY THE PRIVACY ACT. UNAUTHORIZED USE OF THIS DATA IS ILLEGAL
+2 ;;****************************************************
+3 ;;** DIABETES MANAGEMENT SYSTEM **
+4 ;;****************************************************
