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
+4 WRITE !!,"Send Mail Message"
+5 NEW XMLOAD,XMDF,XMMENU
+6 SET XMMENU(0)="XMUSER"
+7 DO LOCK^XM
+8 ;cmi/maw 9/7/06 new
IF Y
DO XMZ^XMA2
+9 DO UNLOCK^XM
+10 QUIT
VFS ;EP;TO VIEW PATIENT REGISTRATION FACE SHEET
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 IF '$GET(DFN)
QUIT
+4 DO CLEAR^VALM1
+5 WRITE @IOF
+6 WRITE !?5,"Display FACE SHEET for: ",$PIECE(BDMPAT0,U),!!
+7 DO VIEWR^XBLM("START^AGFACE")
+8 QUIT
DPSC ;EP;DPSC
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 IF '$GET(DFN)
QUIT
+4 DO CLEAR^VALM1
+5 WRITE @IOF
+6 WRITE !?5,"Display Diabetes Patient Care Summary for: ",$PIECE(BDMPAT0,U),!!
+7 DO VIEWR^XBLM("PRINT^BDMDMSP")
+8 QUIT
PRD ;EP;TO VIEW PATIENT REGISTRATION DATA
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 IF '$GET(DFN)
QUIT
+4 SET BDMSAV=DFN
+5 DO CLEAR^VALM1
+6 DO ^AGVAR
+7 SET AGPAGE=1
+8 ;I '$D(^VA(200,+$G(DUZ),51,+$O(^DIC(19.1,"B","AGZMENU",0)))) D
+9 ;.S AGSEENLY=""
+10 DO L2^AGSEENLY
+11 SET DFN=BDMSAV
+12 QUIT
REGDAT ;EP;TO GATHER AND DISPLAY PATIENT REGISTER DATA
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 SET BDMVALM="BDMV REGISTER"
+4 DO VALM(BDMVALM)
+5 QUIT
RDINIT ;EP;TO INITIALIZE PATIENT REGISTER DATA FOR DISPLAY
+1 DO RDINIT^BDMVRL2
+2 QUIT
BACK SET VALMBCK="R"
+1 QUIT
VSEL ;EP;TO SELECT VISIT TO DISPLAY
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 SET DIR(0)="NO^1:"_BDMJ
+4 SET DIR("A")="Which Visit"
+5 WRITE !
+6 DO DIR^BDMFDIC
+7 IF Y<1!'$DATA(BDM(+Y))
QUIT
+8 SET APCDLOOK=+BDM(Y)
+9 DO VISIT
+10 QUIT
PROB ;EP; called from protocol
PL ;EP; called from protocol - changed in 2015 audit to display only per MU2
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 DO CLEAR^VALM1
+4 DO FULL^VALM1
+5 SET APCDOVRR=""
+6 SET APCDPAT=DFN
+7 DO EN1^BDMPL
+8 SET (DFN,Y)=APCDPAT
+9 DO ^AUPNPAT
+10 DO BACK
+11 QUIT
Z(X) ;SET TMP NODE
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("BDMVR",$JOB,VALMCNT,0)=X
+3 QUIT
