BDMVRL.m

BDMVRL ; IHS/CMI/LAB - VIEW PT RECORD LT ; 29 Sep 2014  11:55 AM

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51

 ;

 ;This routine calls a list template to view a patient's record.

 ;The first screen displayed is the patient's health summary.

 ;

 ;cmi/anch/maw 3/8/2007 changed visit display to be browser based

 ;

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 I '$$PKGCK^BDMVU("APCHS","PCC HEALTH SUMMARY") D  D EXIT Q

 . D MSG^BDMVU("**HEALTH SUMMARY SOFTWARE NOT INSTALLED**",2,1,1)

 ;

 K DFN,BDMQUIT,BMOUT

 K ^TMP("BDMVR",$J)

 F  D GETPAT^BDMVRL5 Q:$D(BDMQUIT)!$D(BDMOUT)  D

 .Q:'$G(BDMRDA)!'$G(BDMRPDA)

 .D REGDAT

 .D FULL^VALM1

 .D EXIT

 K BDMQUIT,BDMOUT

 Q

 ;

HAVEPAT ;EP; -- entry point when patient already known

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 N APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BDMVSAV

 D GETHSTYP^BDMVRL5

 I '$G(APCHSTYP) D EXIT Q

 S APCHSPAT=DFN,BDMVSAV=DFN

 D EN,FULL^VALM1,EXIT

 Q

 ;

EN ;EP; -- main entry point for list template BDMV HS VIEW

 D CLEAR^VALM1

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 N APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BDMVSAV

 D GETHSTYP^BDMVRL5

 I '$G(APCHSTYP) D EXIT Q

 S APCHSPAT=DFN,BDMVSAV=DFN

 S BDMVALM="BDMV HS VIEW"

 D VALM(BDMVALM)

 Q

VALM(BDMVALM) ;EP; -- main entry point for list templates

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S VALMCC=1 ;1=screen mode, 0=scrolling mode

 D TERM^VALM0

 D CLEAR^VALM1

 D EN^VALM(BDMVALM)

 D CLEAR^VALM1

 Q

 ;

HDR ;EP; -- header code

 S VALMSG=$$VALMSG^BDMVU

 Q

 ;

INIT ;EP; -- init variables and list array

 D GUIR^XBLM("EN^APCHS","^TMP(""BDMVR"",$J,")

 S X=0

 F  S X=$O(^TMP("BDMVR",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BDMVR",$J,X,0)=$G(^TMP("BDMVR",$J,X))

 S VALMSG=$$VALMSG^BDMVU

 Q

 ;

HELP ;EP; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ;EP; -- exit code

 K ^TMP("BDMVR",$J)

 K BDM

 Q

 ;

EXPND ;EP; -- expand code

 Q

 ;

PAUSE ; -- end of action pause

 D RETURN^BDMVU

 Q

 ;

CSS ;EP;TO REVIEW CASE SUMMARY

 K BDMQUIT,ACMQUIT

 K ACMMHS,ACMSTYP

 D REG^BDMFUTIL

 S ACMRG=BDMRDA

 S ACMRGNA=BDMREGNM

 Q:$D(BDMQUIT)

 D ^ACMLPAT

 Q:$D(ACMQUIT)!'$G(ACMPTNO)

 S DFN=ACMPTNO

 S BDMRPDA=ACMRGDFN

 I $P(^ACM(41.1,BDMRDA,0),U,10)=1 D

 .S DIR(0)="YO",DIR("A")="Include PCC HEALTH SUMMARY",DIR("B")="NO"

 .W !

 .D ^DIR K DIR

 .I Y=1 S ACMMHS="" D SELTYP^ACMPPDTX

 S (ZTRTN,BDMRTN)="CS1^BDMVRL"

 S BDMBROWS=1

 D ^BDMFZIS

 K BDMBROWS,ACMMHS,ACMSTYP,BDMRTN

 D EN^XBVK("ACM")  ;,EN^XBVK("BDM")

 Q

CS ;EP;TO REVIEW CASE SUMMARY

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 D CLEAR^VALM1

 I $P(^ACM(41.1,BDMRDA,0),U,10)=1 D

 .S DIR(0)="YO",DIR("A")="Include PCC HEALTH SUMMARY",DIR("B")="NO"

 .W !

 .D ^DIR K DIR

 .I Y=1 S ACMMHS="" D SELTYP^ACMPPDTX

 S (ZTRTN,BDMRTN)="CS1^BDMVRL"

 D BROWSE^BDMFZIS

 Q

CS1 ;EP;

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S ACMRG=BDMRDA

 S ACMRGDFN=BDMRPDA

 S ACMPTNO=DFN

 S X=$P(^DPT(DFN,0),U)

 S ACMPATNA=X

 S ACMPTNA2=$P($P(X,",",2)," ")_" "_$P(X,",")

 D ^ACMCTRL  ;cmi/anch/maw 3/22/2007 for version 2.0

 D DQ^BDMPPDT

 Q

AS ;EP;TO REVIEW AUDIT STATUS

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 D CLEAR^VALM1

 N X,BDMY,BDMZ,BDMQUIT,BDMVRLY

 S BDMJOB=$J

 S BDMBTH=$H

 S BDMDMRG=BDMRDA

 S ^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS",DFN)=""

 S ^TMP("BDMDM19",BDMJOB,BDMBTH,"PATS",DFN)=""

 D TIME^BDMDG1

 Q:$G(BDMSTP)

 D EN^XBNEW("IAEP^BDMDG1","BDMJOB;BDMBTH;BDMDMRG;BDMADAT;BDMRED;BDMBDAT;BDMRBD")

 Q

 ;

DLP ;EP;FOR DIABETES LAB PROFILE

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 D CLEAR^VALM1

 N APCHSTYP,APCHSPAT

 I '$D(^APCHSCTL("B","DMS DIABETES LAB REPORT")) D NEWHS^BDMVRL5

 S APCHSTYP=$O(^APCHSCTL("B","DMS DIABETES LAB REPORT",0))

 Q:'APCHSTYP

 S APCHSPAT=DFN

 D EN^APCHS

 D PAUSE^BDMFMENU

 Q

APPTS ;EP;TO DISPLAY APPOINTMENTS

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S BDMVALM="BDMV APPOINTMENTS"

 D VALM(BDMVALM)

 Q

APPINIT ;EP;TO DISPLAY APPOINTMENTS

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 K ^TMP("BDMVR",$J)

 N J,X,Y,Z,BDMAPPDA,BDMPAT0

 S VALMCNT=0

 S X="     CLINIC                            TIME     DATE"

 D Z(X)

 S X="     ------------------------------    -------- ----------"

 D Z(X)

 S BDMAPPDA=DT-1

 F  S BDMAPPDA=$O(^DPT(DFN,"S",BDMAPPDA)) Q:'BDMAPPDA  D

 .S BDMPAT0=$G(^DPT(DFN,"S",BDMAPPDA,0))

 .Q:'+BDMPAT0!($P(BDMPAT0,U,2)]"")

 .S Z=$P($G(^SC(+BDMPAT0,0)),U)

 .S Y=BDMAPPDA

 .X ^DD("DD")

 .S X=""

 .S $E(X,6)=Z

 .S $E(X,36)=" at "_$P(Y,"@",2)_" on "_$P(Y,"@")

 .D Z(X)

 S:VALMCNT=2 ^TMP("BDMVR",$J,3,0)="     NO APPOINTMENTS LISTED"

 D BACK

 Q

LVD ;EP;TO DISPLAY LAST VISIT

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 N X

 S X=$O(^AUPNVSIT("AA",DFN,0))

 I 'X D  Q

 .W !,"No visits on file for this patient."

 .D PAUSE^BDMFMENU

 S X=$O(^AUPNVSIT("AA",DFN,X,0))

 S APCDLOOK=X

VISIT I APCDLOOK S APCDVSIT=APCDLOOK,APCDDATE=+^AUPNVSIT(APCDLOOK,0),APCDTYPE=$P(^AUPNVSIT(APCDLOOK,0),U,3),APCDCAT=$P(^(0),U,7),APCDLOC=$P(^(0),U,6),APCDCLN=$P(^(0),U,8)

 S APCDVDSP=APCDVSIT

 D CLEAR^VALM1

 D ^APCDVD  ;cmi/anch/maw 3/8/2007 for browser display

 ;D ^APCDVDSP  cmi/anch/maw 3/8/2007 orig line

 Q

GETVISIT ;EP;TO GET VISIT

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S APCDPAT=DFN

 W !

 D GETVISIT^APCDDISP

 I $G(APCDVSIT) S APCDLOOK=APCDVSIT D VISIT:$G(APCDVSIT)

 Q

FS ;EP;TO VIEW A FLOW SHEET

 D CLEAR^VALM1

 N APCHSTYP,APCHSPAT

 I '$D(^APCHSCTL("B","DMS DIABETIC FLOWSHEET")) D NEWHS^BDMVRL5

 ;S APCHSTYP=$O(^APCHSCTL("B","DMS DIABETIC FLOWSHEET",0))

 S DIC="^APCHSCTL("

 S DIC(0)="AEMQZ"

 S DIC("A")="Which FLOW SHEET: "

 S DIC("B")="DMS DIABETIC FLOWSHEET"

 W !

 D DIC^BDMFDIC

 I +Y<1 K BDMQUIT Q

 S APCHSTYP=+Y

 S APCHSPAT=DFN

 D EN^APCHS

 D PAUSE^BDMFMENU

 Q

HS ;EP;TO VIEW A HEALTH SUMMARY

 D EN

 Q

LP ;EP;TO DISPLAY LAB PROFILE

 D CLEAR^VALM1

 N APCHSTYP,APCHSPAT

 I '$D(^APCHSCTL("B","DMS LAB REPORT")) D NEWHS^BDMVRL5

 S APCHSTYP=$O(^APCHSCTL("B","DMS LAB REPORT",0))

 Q:'APCHSTYP

 S APCHSPAT=DFN

 D EN^APCHS

 D PAUSE^BDMFMENU

 Q

REF ;EP;TO EDIT REFERRALS

 Q

LOPT ;EP;TO EDIT LOCAL OPTION

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="1101;1102"

 W !!

 D DIE^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

RS ;EP;TO EDIT REGISTER STATUS

 D FULL^VALM1

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="1"

 W !!

 D DIE^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

WF ;EP;TO EDIT WHERE FOLLOWED

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="10"

 W !!

 D DIE^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

CM ;EP;TO EDIT CASE MANAGER

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="6"

 W !!

 D DIE^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

CC ;EP;TO EDIT CONTACT

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="14"

 W !!

 D DIE^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

ERD ;EP;TO EDIT REGISTER DATA

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DA=BDMRPDA

 S DIE=9002241

 S DR="[BDM CMS REGISTER]"

 D DDS^BDMFDIC

 D DXUPD^BDMVRL5

 S DA=BDMRPDA

 S DIE="^ACM(41,"

 S DR="11////"_DT

 D DIE^BDMFDIC

 D PP^BDMVRL5

 Q

MM ;EP;TO SEND MAIL MESSAGE

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 D CLEAR^VALM1

 W !!,"Send Mail Message"

 N XMLOAD,XMDF,XMMENU

 S XMMENU(0)="XMUSER"

 D LOCK^XM

 I Y D XMZ^XMA2  ;cmi/maw 9/7/06 new

 D UNLOCK^XM

 Q

VFS ;EP;TO VIEW PATIENT REGISTRATION FACE SHEET

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 Q:'$G(DFN)

 D CLEAR^VALM1

 W @IOF

 W !?5,"Display FACE SHEET for: ",$P(BDMPAT0,U),!!

 D VIEWR^XBLM("START^AGFACE")

 Q

DPSC ;EP;DPSC

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 Q:'$G(DFN)

 D CLEAR^VALM1

 W @IOF

 W !?5,"Display Diabetes Patient Care Summary for: ",$P(BDMPAT0,U),!!

 D VIEWR^XBLM("PRINT^BDMDMSP")

 Q

PRD ;EP;TO VIEW PATIENT REGISTRATION DATA

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 Q:'$G(DFN)

 S BDMSAV=DFN

 D CLEAR^VALM1

 D ^AGVAR

 S AGPAGE=1

 ;I '$D(^VA(200,+$G(DUZ),51,+$O(^DIC(19.1,"B","AGZMENU",0)))) D

 ;.S AGSEENLY=""

 D L2^AGSEENLY

 S DFN=BDMSAV

 Q

REGDAT ;EP;TO GATHER AND DISPLAY PATIENT REGISTER DATA

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S BDMVALM="BDMV REGISTER"

 D VALM(BDMVALM)

 Q

RDINIT ;EP;TO INITIALIZE PATIENT REGISTER DATA FOR DISPLAY

 D RDINIT^BDMVRL2

 Q

BACK S VALMBCK="R"

 Q

VSEL ;EP;TO SELECT VISIT TO DISPLAY

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 S DIR(0)="NO^1:"_BDMJ

 S DIR("A")="Which Visit"

 W !

 D DIR^BDMFDIC

 Q:Y<1!'$D(BDM(+Y))

 S APCDLOOK=+BDM(Y)

 D VISIT

 Q

PROB ;EP; called from protocol

PL ;EP; called from protocol - changed in 2015 audit to display only per MU2

 D REG^BDMFUTIL

 Q:$D(BDMQUIT)

 D CLEAR^VALM1

 D FULL^VALM1

 S APCDOVRR=""

 S APCDPAT=DFN

 D EN1^BDMPL

 S (DFN,Y)=APCDPAT

 D ^AUPNPAT

 D BACK

 Q

Z(X) ;SET TMP NODE

 S VALMCNT=VALMCNT+1

 S ^TMP("BDMVR",$J,VALMCNT,0)=X

 Q

BDMVRL    ; IHS/CMI/LAB - VIEW PT RECORD LT ; 29 Sep 2014  11:55 AM

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51

 +2       ;

 +3       ;This routine calls a list template to view a patient's record.

 +4       ;The first screen displayed is the patient's health summary.

 +5       ;

 +6       ;cmi/anch/maw 3/8/2007 changed visit display to be browser based

 +7       ;

 +8        DO REG^BDMFUTIL

 +9        IF $DATA(BDMQUIT)

               QUIT 

 +10       IF '$$PKGCK^BDMVU("APCHS","PCC HEALTH SUMMARY")

               Begin DoDot:1

 +11               DO MSG^BDMVU("**HEALTH SUMMARY SOFTWARE NOT INSTALLED**",2,1,1)

               End DoDot:1

               DO EXIT

               QUIT 

 +12      ;

 +13       KILL DFN,BDMQUIT,BMOUT

 +14       KILL ^TMP("BDMVR",$JOB)

 +15       FOR 

               DO GETPAT^BDMVRL5

               IF $DATA(BDMQUIT)!$DATA(BDMOUT)

                   QUIT 

               Begin DoDot:1

 +16               IF '$GET(BDMRDA)!'$GET(BDMRPDA)

                       QUIT 

 +17               DO REGDAT

 +18               DO FULL^VALM1

 +19               DO EXIT

               End DoDot:1

 +20       KILL BDMQUIT,BDMOUT

 +21       QUIT 

 +22      ;

HAVEPAT   ;EP; -- entry point when patient already known

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        NEW APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BDMVSAV

 +4        DO GETHSTYP^BDMVRL5

 +5        IF '$GET(APCHSTYP)

               DO EXIT

               QUIT 

 +6        SET APCHSPAT=DFN

           SET BDMVSAV=DFN

 +7        DO EN

           DO FULL^VALM1

           DO EXIT

 +8        QUIT 

 +9       ;

EN        ;EP; -- main entry point for list template BDMV HS VIEW

 +1        DO CLEAR^VALM1

 +2        DO REG^BDMFUTIL

 +3        IF $DATA(BDMQUIT)

               QUIT 

 +4        NEW APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BDMVSAV

 +5        DO GETHSTYP^BDMVRL5

 +6        IF '$GET(APCHSTYP)

               DO EXIT

               QUIT 

 +7        SET APCHSPAT=DFN

           SET BDMVSAV=DFN

 +8        SET BDMVALM="BDMV HS VIEW"

 +9        DO VALM(BDMVALM)

 +10       QUIT 

VALM(BDMVALM) ;EP; -- main entry point for list templates

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3       ;1=screen mode, 0=scrolling mode

           SET VALMCC=1

 +4        DO TERM^VALM0

 +5        DO CLEAR^VALM1

 +6        DO EN^VALM(BDMVALM)

 +7        DO CLEAR^VALM1

 +8        QUIT 

 +9       ;

HDR       ;EP; -- header code

 +1        SET VALMSG=$$VALMSG^BDMVU

 +2        QUIT 

 +3       ;

INIT      ;EP; -- init variables and list array

 +1        DO GUIR^XBLM("EN^APCHS","^TMP(""BDMVR"",$J,")

 +2        SET X=0

 +3        FOR 

               SET X=$ORDER(^TMP("BDMVR",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BDMVR",$JOB,X,0)=$GET(^TMP("BDMVR",$JOB,X))

               End DoDot:1

 +6        SET VALMSG=$$VALMSG^BDMVU

 +7        QUIT 

 +8       ;

HELP      ;EP; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ;EP; -- exit code

 +1        KILL ^TMP("BDMVR",$JOB)

 +2        KILL BDM

 +3        QUIT 

 +4       ;

EXPND     ;EP; -- expand code

 +1        QUIT 

 +2       ;

PAUSE     ; -- end of action pause

 +1        DO RETURN^BDMVU

 +2        QUIT 

 +3       ;

CSS       ;EP;TO REVIEW CASE SUMMARY

 +1        KILL BDMQUIT,ACMQUIT

 +2        KILL ACMMHS,ACMSTYP

 +3        DO REG^BDMFUTIL

 +4        SET ACMRG=BDMRDA

 +5        SET ACMRGNA=BDMREGNM

 +6        IF $DATA(BDMQUIT)

               QUIT 

 +7        DO ^ACMLPAT

 +8        IF $DATA(ACMQUIT)!'$GET(ACMPTNO)

               QUIT 

 +9        SET DFN=ACMPTNO

 +10       SET BDMRPDA=ACMRGDFN

 +11       IF $PIECE(^ACM(41.1,BDMRDA,0),U,10)=1

               Begin DoDot:1

 +12               SET DIR(0)="YO"

                   SET DIR("A")="Include PCC HEALTH SUMMARY"

                   SET DIR("B")="NO"

 +13               WRITE !

 +14               DO ^DIR

                   KILL DIR

 +15               IF Y=1

                       SET ACMMHS=""

                       DO SELTYP^ACMPPDTX

               End DoDot:1

 +16       SET (ZTRTN,BDMRTN)="CS1^BDMVRL"

 +17       SET BDMBROWS=1

 +18       DO ^BDMFZIS

 +19       KILL BDMBROWS,ACMMHS,ACMSTYP,BDMRTN

 +20      ;,EN^XBVK("BDM")

           DO EN^XBVK("ACM")

 +21       QUIT 

CS        ;EP;TO REVIEW CASE SUMMARY

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        DO CLEAR^VALM1

 +4        IF $PIECE(^ACM(41.1,BDMRDA,0),U,10)=1

               Begin DoDot:1

 +5                SET DIR(0)="YO"

                   SET DIR("A")="Include PCC HEALTH SUMMARY"

                   SET DIR("B")="NO"

 +6                WRITE !

 +7                DO ^DIR

                   KILL DIR

 +8                IF Y=1

                       SET ACMMHS=""

                       DO SELTYP^ACMPPDTX

               End DoDot:1

 +9        SET (ZTRTN,BDMRTN)="CS1^BDMVRL"

 +10       DO BROWSE^BDMFZIS

 +11       QUIT 

CS1       ;EP;

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET ACMRG=BDMRDA

 +4        SET ACMRGDFN=BDMRPDA

 +5        SET ACMPTNO=DFN

 +6        SET X=$PIECE(^DPT(DFN,0),U)

 +7        SET ACMPATNA=X

 +8        SET ACMPTNA2=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +9       ;cmi/anch/maw 3/22/2007 for version 2.0

           DO ^ACMCTRL

 +10       DO DQ^BDMPPDT

 +11       QUIT 

AS        ;EP;TO REVIEW AUDIT STATUS

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        DO CLEAR^VALM1

 +4        NEW X,BDMY,BDMZ,BDMQUIT,BDMVRLY

 +5        SET BDMJOB=$JOB

 +6        SET BDMBTH=$HOROLOG

 +7        SET BDMDMRG=BDMRDA

 +8        SET ^XTMP("BDMDM19",BDMJOB,BDMBTH,"PATS",DFN)=""

 +9        SET ^TMP("BDMDM19",BDMJOB,BDMBTH,"PATS",DFN)=""

 +10       DO TIME^BDMDG1

 +11       IF $GET(BDMSTP)

               QUIT 

 +12       DO EN^XBNEW("IAEP^BDMDG1","BDMJOB;BDMBTH;BDMDMRG;BDMADAT;BDMRED;BDMBDAT;BDMRBD")

 +13       QUIT 

 +14      ;

DLP       ;EP;FOR DIABETES LAB PROFILE

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        DO CLEAR^VALM1

 +4        NEW APCHSTYP,APCHSPAT

 +5        IF '$DATA(^APCHSCTL("B","DMS DIABETES LAB REPORT"))

               DO NEWHS^BDMVRL5

 +6        SET APCHSTYP=$ORDER(^APCHSCTL("B","DMS DIABETES LAB REPORT",0))

 +7        IF 'APCHSTYP

               QUIT 

 +8        SET APCHSPAT=DFN

 +9        DO EN^APCHS

 +10       DO PAUSE^BDMFMENU

 +11       QUIT 

APPTS     ;EP;TO DISPLAY APPOINTMENTS

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET BDMVALM="BDMV APPOINTMENTS"

 +4        DO VALM(BDMVALM)

 +5        QUIT 

APPINIT   ;EP;TO DISPLAY APPOINTMENTS

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        KILL ^TMP("BDMVR",$JOB)

 +4        NEW J,X,Y,Z,BDMAPPDA,BDMPAT0

 +5        SET VALMCNT=0

 +6        SET X="     CLINIC                            TIME     DATE"

 +7        DO Z(X)

 +8        SET X="     ------------------------------    -------- ----------"

 +9        DO Z(X)

 +10       SET BDMAPPDA=DT-1

 +11       FOR 

               SET BDMAPPDA=$ORDER(^DPT(DFN,"S",BDMAPPDA))

               IF 'BDMAPPDA

                   QUIT 

               Begin DoDot:1

 +12               SET BDMPAT0=$GET(^DPT(DFN,"S",BDMAPPDA,0))

 +13               IF '+BDMPAT0!($PIECE(BDMPAT0,U,2)]"")

                       QUIT 

 +14               SET Z=$PIECE($GET(^SC(+BDMPAT0,0)),U)

 +15               SET Y=BDMAPPDA

 +16               XECUTE ^DD("DD")

 +17               SET X=""

 +18               SET $EXTRACT(X,6)=Z

 +19               SET $EXTRACT(X,36)=" at "_$PIECE(Y,"@",2)_" on "_$PIECE(Y,"@")

 +20               DO Z(X)

               End DoDot:1

 +21       IF VALMCNT=2

               SET ^TMP("BDMVR",$JOB,3,0)="     NO APPOINTMENTS LISTED"

 +22       DO BACK

 +23       QUIT 

LVD       ;EP;TO DISPLAY LAST VISIT

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        NEW X

 +4        SET X=$ORDER(^AUPNVSIT("AA",DFN,0))

 +5        IF 'X

               Begin DoDot:1

 +6                WRITE !,"No visits on file for this patient."

 +7                DO PAUSE^BDMFMENU

               End DoDot:1

               QUIT 

 +8        SET X=$ORDER(^AUPNVSIT("AA",DFN,X,0))

 +9        SET APCDLOOK=X

VISIT      IF APCDLOOK

               SET APCDVSIT=APCDLOOK

               SET APCDDATE=+^AUPNVSIT(APCDLOOK,0)

               SET APCDTYPE=$PIECE(^AUPNVSIT(APCDLOOK,0),U,3)

               SET APCDCAT=$PIECE(^(0),U,7)

               SET APCDLOC=$PIECE(^(0),U,6)

               SET APCDCLN=$PIECE(^(0),U,8)

 +1        SET APCDVDSP=APCDVSIT

 +2        DO CLEAR^VALM1

 +3       ;cmi/anch/maw 3/8/2007 for browser display

           DO ^APCDVD

 +4       ;D ^APCDVDSP  cmi/anch/maw 3/8/2007 orig line

 +5        QUIT 

GETVISIT  ;EP;TO GET VISIT

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET APCDPAT=DFN

 +4        WRITE !

 +5        DO GETVISIT^APCDDISP

 +6        IF $GET(APCDVSIT)

               SET APCDLOOK=APCDVSIT

               IF $GET(APCDVSIT)

                   DO VISIT

 +7        QUIT 

FS        ;EP;TO VIEW A FLOW SHEET

 +1        DO CLEAR^VALM1

 +2        NEW APCHSTYP,APCHSPAT

 +3        IF '$DATA(^APCHSCTL("B","DMS DIABETIC FLOWSHEET"))

               DO NEWHS^BDMVRL5

 +4       ;S APCHSTYP=$O(^APCHSCTL("B","DMS DIABETIC FLOWSHEET",0))

 +5        SET DIC="^APCHSCTL("

 +6        SET DIC(0)="AEMQZ"

 +7        SET DIC("A")="Which FLOW SHEET: "

 +8        SET DIC("B")="DMS DIABETIC FLOWSHEET"

 +9        WRITE !

 +10       DO DIC^BDMFDIC

 +11       IF +Y<1

               KILL BDMQUIT

               QUIT 

 +12       SET APCHSTYP=+Y

 +13       SET APCHSPAT=DFN

 +14       DO EN^APCHS

 +15       DO PAUSE^BDMFMENU

 +16       QUIT 

HS        ;EP;TO VIEW A HEALTH SUMMARY

 +1        DO EN

 +2        QUIT 

LP        ;EP;TO DISPLAY LAB PROFILE

 +1        DO CLEAR^VALM1

 +2        NEW APCHSTYP,APCHSPAT

 +3        IF '$DATA(^APCHSCTL("B","DMS LAB REPORT"))

               DO NEWHS^BDMVRL5

 +4        SET APCHSTYP=$ORDER(^APCHSCTL("B","DMS LAB REPORT",0))

 +5        IF 'APCHSTYP

               QUIT 

 +6        SET APCHSPAT=DFN

 +7        DO EN^APCHS

 +8        DO PAUSE^BDMFMENU

 +9        QUIT 

REF       ;EP;TO EDIT REFERRALS

 +1        QUIT 

LOPT      ;EP;TO EDIT LOCAL OPTION

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET DA=BDMRPDA

 +4        SET DIE="^ACM(41,"

 +5        SET DR="1101;1102"

 +6        WRITE !!

 +7        DO DIE^BDMFDIC

 +8        DO DXUPD^BDMVRL5

 +9        SET DA=BDMRPDA

 +10       SET DIE="^ACM(41,"

 +11       SET DR="11////"_DT

 +12       DO DIE^BDMFDIC

 +13       DO PP^BDMVRL5

 +14       QUIT 

RS        ;EP;TO EDIT REGISTER STATUS

 +1        DO FULL^VALM1

 +2        DO REG^BDMFUTIL

 +3        IF $DATA(BDMQUIT)

               QUIT 

 +4        SET DA=BDMRPDA

 +5        SET DIE="^ACM(41,"

 +6        SET DR="1"

 +7        WRITE !!

 +8        DO DIE^BDMFDIC

 +9        DO DXUPD^BDMVRL5

 +10       SET DA=BDMRPDA

 +11       SET DIE="^ACM(41,"

 +12       SET DR="11////"_DT

 +13       DO DIE^BDMFDIC

 +14       DO PP^BDMVRL5

 +15       QUIT 

WF        ;EP;TO EDIT WHERE FOLLOWED

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET DA=BDMRPDA

 +4        SET DIE="^ACM(41,"

 +5        SET DR="10"

 +6        WRITE !!

 +7        DO DIE^BDMFDIC

 +8        DO DXUPD^BDMVRL5

 +9        SET DA=BDMRPDA

 +10       SET DIE="^ACM(41,"

 +11       SET DR="11////"_DT

 +12       DO DIE^BDMFDIC

 +13       DO PP^BDMVRL5

 +14       QUIT 

CM        ;EP;TO EDIT CASE MANAGER

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET DA=BDMRPDA

 +4        SET DIE="^ACM(41,"

 +5        SET DR="6"

 +6        WRITE !!

 +7        DO DIE^BDMFDIC

 +8        DO DXUPD^BDMVRL5

 +9        SET DA=BDMRPDA

 +10       SET DIE="^ACM(41,"

 +11       SET DR="11////"_DT

 +12       DO DIE^BDMFDIC

 +13       DO PP^BDMVRL5

 +14       QUIT 

CC        ;EP;TO EDIT CONTACT

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET DA=BDMRPDA

 +4        SET DIE="^ACM(41,"

 +5        SET DR="14"

 +6        WRITE !!

 +7        DO DIE^BDMFDIC

 +8        DO DXUPD^BDMVRL5

 +9        SET DA=BDMRPDA

 +10       SET DIE="^ACM(41,"

 +11       SET DR="11////"_DT

 +12       DO DIE^BDMFDIC

 +13       DO PP^BDMVRL5

 +14       QUIT 

ERD       ;EP;TO EDIT REGISTER DATA

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        SET DA=BDMRPDA

 +4        SET DIE=9002241

 +5        SET DR="[BDM CMS REGISTER]"

 +6        DO DDS^BDMFDIC

 +7        DO DXUPD^BDMVRL5

 +8        SET DA=BDMRPDA

 +9        SET DIE="^ACM(41,"

 +10       SET DR="11////"_DT

 +11       DO DIE^BDMFDIC

 +12       DO PP^BDMVRL5

 +13       QUIT 

MM        ;EP;TO SEND MAIL MESSAGE

 +1        DO REG^BDMFUTIL

 +2        IF $DATA(BDMQUIT)

               QUIT 

 +3        DO CLEAR^VALM1