BDMFMENU.m

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       ;;****************************************************