BDMVRL6 ; IHS/CMI/LAB - REPORTS INTERFACE ; [ 02/23/2009 9:13 AM ]
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,4,10,12**;JUN 14, 2007;Build 51
;VARIOUS INTERFACE CALLS FOR REPORTS
;GUI INTERFACE CODE & AND APPOINTMENT REPORTS
;
ACTIVE ;EP;TO SELECT PATIENT STATUS FOR REPORTS
K BDMQUIT
W !!,"Select the Patient Status for this report"
S DIR(0)="SO^A:Active;I:Inactive;T:Transient;U:Unreviewed;D:Deceased;N:Non-IHS;NON:Noncompliant;Z:All Patients"
S DIR("A")="Select patient status"
S DIR("B")="Active"
D DIR^BDMFDIC
I Y]"","AITUDNONZ"[Y S BDM("STATUS")=Y ;IHS/CMI/TMJ Non Compliant Fix
E S BDMQUIT=""
Q
REPORTS ;EP;TO SELECT REPORTS
S DIR(0)="SO^1:Individual Case Summary;2:Case Summary for Multiple Patients;3:Master List of Diabetes Register Patients;4:Statistical Reports"
S DIR("A")="Which Report"
W !
D DIR^BDMFDIC
I 'Y S BDMQUIT="" Q
I Y=1 D R1 Q
I Y=2 D R2 Q
I Y=3 D R3 Q
I Y=4 D R4 Q
Q
SORT1 ;EP;TO SORT DIAGNOSIS AND COMPLICATION REPORTS
W !,"Sort the ",$G(BDM("REPORT"))," Report by"
S DIR(0)="SO^1:Alpha Order by Patient;2:Alpha Order by Patient within Community;3:Alpha Order within Complication"
S DIR("A")="Which One"
S DIR("B")=1
D DIR^BDMFDIC
I 'Y S BDMQUIT="" Q
S BDM("ORDER")=Y
Q
R1 ;INDIVIDUAL HEALTH SUMMARY
Q
R2 ;MULTIPLE HEALTH SUMMARY
Q
R3 ;MASTER LIST
Q
R4 ;STATISTICAL REPORTS
Q
SORT ;SORT REPORTS
Q
COMM ;SELECT COMMUNITY
S DIC="^AUTTCOM("
S DIC(0)="AEMQZ"
S DIC("A")="Which COMMUNITY: "
W !,"Press ENTER to include all communities)"
D DIC^BDMFDIC
I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
I X="" S BDM("COMMUNITY")="ALL"
E S BDM("COMMUNITY")=+Y
Q
PROVIDER ;EP;SELECT PROVIDER
S DIC=$S(^DD(9000001,.14,0)[200:"^VA(200,",1:"^DIC(16,")
S DIC(0)="AEMQZ"
S DIC("A")="Which PROVIDER: "
W !,"Press ENTER to include all PROVIDERS)"
D DIC^BDMFDIC
I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
I X="" S BDM("PROVIDER")="ALL"
E S BDM("PROVIDER")=+Y
Q
A1 ;
S DIR(0)="SO^1:Active Patients Only;2:All Patients in the Register"
S DIR("A")="Which one"
S DIR("A",1)="Do you want Active patients Only"
S DIR("A")="or All Patients in the Register"
S DIR("B")="Active Patients Only"
D DIR^BDMFDIC
I Y<1 S BDMQUIT="" Q
S BDM("ACTIVE")=$S(Y=1:"ACTIVE",1:"ALL")
Q
C1 ;
S DIR(0)="SO^1:All Complications;2:One Particular Complication"
S DIR("A",1)="Do you want All Complications"
S DIR("A")="or One Particular Complication"
S DIR("B")="All Complications"
W !
D DIR^BDMFDIC
I Y<1 S BDMQUIT="" Q
I Y=1 S BDM("COMPLICATION")="ALL" Q
E D COMP
Q
D1 ;
S DIR(0)="SO^1:All Diagnoses;2:One Particular Diagnosis"
S DIR("A",1)="Do you want All Diagnoses"
S DIR("A")="or One Particular Diagnosis"
S DIR("B")="All Diagnoses"
W !
D DIR^BDMFDIC
I Y<1 S BDMQUIT="" Q
I Y=1 S BDM("DIAGNOSIS")="ALL" Q
E D COMP
Q
COMP ;SELECT COMPLICATION
S DIC="^ACM(42.1,"
S DIC(0)="AEMQZ"
S DIC("A")="Which COMPLICATION: "
S DIC("S")="I $D(^ACM(42.1,""RG"",BDMRG,+Y))"
W !
D DIC^BDMFDIC
I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
I X="" D Q
.S BDM("COMPLICATION")="ALL"
.W !!,"No COMPLICATION was selected."
.W !,"The report will include all COMPLICATIONS."
.H 2
E S BDM("COMPLICATION")=+Y
Q
DIAG ;SELECT DIAGNOSIS
S DIC="^ACM(44.1,"
S DIC(0)="AEMQZ"
S DIC("A")="Which DIAGNOSIS: "
S DIC("S")="I $D(^ACM(44.1,""RG"",BDMRG,+Y))"
W !
D DIC^BDMFDIC
I $D(BDMQUIT)!$D(BDMOUT) S BDMQUIT="" Q
I X="" D Q
.S BDM("DIAGNOSIS")="ALL"
.W !!,"No DIAGNOSIS was selected."
.W !,"The report will include all DIAGNOSES."
.H 2
E S BDM("DIAGNOSIS")=+Y
Q
D A1,C1,SORT1
Q
MCS ;EP;TO PRINT MULTIPLE CASE SUMMARY
K ACMES,ACMEP,ACMPS
S (ACMEP,ACMPP,ACMRGTP)=""
D:'$D(ACMDM) ^ACMGTP
S ACMENTRY="MPS"
D ENTRY^ACMSRT
Q
ICS ;EP;TO PRINT INDIVIDUAL CASE SUMMARY
D REG^BDMFUTIL
Q:$D(BDMQUIT)
K ACMES,ACMEP,ACMPS
S (ACMEP,ACMPP,ACMRGTP)=""
D:'$D(ACMDM) ^ACMGTP
S ACMPP=""
D QONE^ACMED
Q
ML ;EP;TO PRINT MASTER LIST
D REG^BDMFUTIL
Q:$D(BDMQUIT)
K ACMES,ACMEP,ACMPS
S (ACMEP,ACMPP,ACMRGTP)=""
D:'$D(ACMDM) ^ACMGTP
S ACMENTRY="ML"
D ENTRY^ACMSRT
Q
PSR ;EP;TO PRINT PATIENT AND STATISTICAL REPORTS
D REG^BDMFUTIL
S ACMDM=""
Q:$D(BDMQUIT)
K ACMES,ACMEP,ACMPS
S (ACMPP,ACMRGTP)=""
D:'$D(ACMDM) ^ACMGTP
D CURRENT^ACMED
S ACMPP=""
S ACMRG=BDMRDA
S ACMRGNA=BDMREGNM
S ACMCTRLP="REG;CMP;DX;FM;PROB;CR;CT"
S ACMCTRLS="CMPL;DXL;AD"
D ^ACMQK
K ACMPP
D EN^XBVK("ACM"),EN^XBVK("BDM")
Q
GENRET ;EP;TO ACCESS GENERAL RETRIEVAL (LISTER)
W @IOF
D REG^BDMFUTIL
Q:$D(BDMQUIT)
S ACMRG=BDMRDA
S ACMRGNA=BDMREGNM
S ACMDM=""
D CONTROL^ACMCTRL
S ACMCTRLP=ACMCTRL
D INFORM^ACMRL01
K ACMES,ACMEP,ACMPS
S (ACMEP,ACMPP,ACMRGTP)=""
D:'$D(ACMDM) ^ACMGTP
K ACMPP
D ^ACMRL
K ACMPP,ACMEP,ACMRGTP,ACMCTRLP,ACMCTRL,ACMCRTLS
Q
APPT ;EP;TO PRINT LIST OF DM PATIENT'S APPOINTMENTS
D REG^BDMFUTIL
Q:$D(BDMQUIT)
D APP1
APPEXIT K BDM,BDMQUIT,BDMOUT
K ^TMP("BDMVR",$J)
Q
APP1 S BDMRDA=$O(^ACM(41.1,"B",BDMREGNM,0))
Q:'BDMRDA
D ^BDMDATE
Q:$D(BDMQUIT)
S BDMBROWS=1 ;cmi/maw 1/17/2006 so it asks for print or browse
D ZIS
K BDMBROWS ;cmi/maw 1/17/2006 so variable does not hang around
Q
APPINIT ;DISPLAY APPOINTMENTS
K ^TMP("BDMTMP",$J),^TMP("BDMVR",$J)
S (BDMJ,VALMCNT)=0
D APPHEAD
N X,Y,Z,DFN,PAT
S BDMRPDA=0
F S BDMRPDA=$O(^ACM(41,"B",BDMRDA,BDMRPDA)) Q:'BDMRPDA D
.S DFN=$P($G(^ACM(41,BDMRPDA,0)),U,2)
.Q:'$D(^DPT(+DFN,"S"))
.D PAT^BDMVRL4(DFN,BDMRPDA)
.Q:$D(^DPT(DFN,.35))
.D APP(DFN,BDMBEGIN,BDMEND)
S Y=""
F S Y=$O(^TMP("BDMTMP",$J,Y)) Q:Y="" D
.S Z=0
.F S Z=$O(^TMP("BDMTMP",$J,Y,Z)) Q:'Z D
..S X=^TMP("BDMTMP",$J,Y,Z)
..D Z(X)
Q
APP(DFN,BDMBEGIN,BDMEND) ;EP;TO LIST UPCOMING APPOINTMENTS
Q:'$G(DFN)!'$G(BDMBEGIN)!'$G(BDMEND)
N X,Y,Z,PAT
S Y=BDMBEGIN-.0001
S X=""
F S Y=$O(^DPT(DFN,"S",Y)) Q:'Y!(BDMEND+.9999<Y) D
.S Z=$G(^DPT(DFN,"S",Y,0))
.Q:Z=""
.S X=""
.S (PAT,X)=$E($P($G(^DPT(DFN,0)),U),1,20)
.S $E(X,22)=$E($P($G(^SC(+Z,0)),U),1,20)
.S DATE=Y
.X ^DD("DD")
.S $E(X,44)=$P(Y,"@")
.S $E(X,56)="at "_$P(Y,"@",2)
.S BDMJ=BDMJ+1
.S ^TMP("BDMTMP",$J,PAT,BDMJ)=X
.;S X="" ;cmi/maw 1/17/2007 this should get reset prior to follow up appts
.I $D(BDMFUAPP) D
..S Y=$E(X,22,999)
..S X=""
..S $E(X,6)="NEXT APPT: "
..S $E(X,17)=Y
.D Z(X) ;cmi/maw 9/7/06 test to see if this works for next appt.
Q
APPHEAD ;PRINT APPOINTMENT LIST HEADER
N X,Y,Z
S X=""
S $E(X,10)="DIABETES MANAGEMENT SYSTEM - PATIENT APPOINTMENTS"
D Z(X)
S Y=DT
X ^DD("DD")
S X=""
S $E(X,10)="REPORT DATE....: "_Y
D Z(X)
S Y=BDMBEGIN
X ^DD("DD")
S X=""
S $E(X,10)="APPTS BEGINNING: "_Y
D Z(X)
S Y=BDMEND
X ^DD("DD")
S X=""
S $E(X,10)="APPTS ENDING...: "_Y
D Z(X)
S X=" "
D Z(X)
S X="PATIENT"
S $E(X,22)="CLINIC"
S $E(X,44)="APPT DATE/TIME"
D Z(X)
S X="--------------------"
S $E(X,22)="---------------------"
S $E(X,44)="---------------------"
D Z(X)
Q
Z(X) ;SET TMP GLOBAL
I IO'=IO(0) W !,X Q
S VALMCNT=VALMCNT+1
S ^TMP("BDMVR",$J,VALMCNT,0)=X
Q
ZIS ;DEVICE INTERFACE
S ZTSAVE("BDM*")=""
S (ZTRTN,BDMRTN)="APRINT^BDMVRL6"
D ^BDMFZIS
Q
APRINT ;EP;TO PRINT APPOINTMENT LIST
D REG^BDMFUTIL
Q:$D(BDMQUIT)
D APPINIT
I IO=IO(0),'$G(BDMPRINT) D Q ;cmi/maw 1/17/2006 don't browse if they select print
.S BDMHDR=""
.S BDMVALM="BDM APPOINTMENT LIST"
.D VALM^BDMVRL(BDMVALM) Q
S J=0
F S J=$O(^TMP("BDMVR",$J,J)) Q:'J!$D(BDMQUIT) D
.S X=$G(^TMP("BDMVR",$J,J,0))
.I X]"" U IO W !,X
.I IOSL-4<$Y D PAUSE^BDMFMENU Q:$D(BDMQUIT) W @IOF S J=J-8 D APPHEAD
Q
;
BDMGA(BDMRET,BDMBEGIN,BDNEND,BDMRDA,BDMGUI) ;PEP - gui call
S BDMJ=$J
S BDMH=$H
F X="BDMJ","BDMH","BDMBEGIN","BDMEND","BDMRDA" S @X=$G(@X)
I $G(BDMJ)="" S BDMRET=-1 Q
I $G(BDMH)="" S BDMRET=-1 Q
;create entry in fileman file to hold output
N BDMOPT ;maw
S BDMOPT="List Patient Appointments"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,D0,DIC
S X=DUZ_"."_BDMH
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05///1;.06///"_$G(BDMOPT)_";.07///R"
S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003002.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BDMRET=-1 Q
S BDMIEN=+Y
S BDMRET=BDMIEN
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP ;for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMVRL6",ZTDESC="GUI DM LIST PATIENT APPOINTMENTS" D ^%ZTLOAD
D XIT
Q
;
GUIEP ;EP - called from taskman
;D ^FUPRINT
K ^TMP($J,"BDMLPA")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("APPINIT^BDMVRL6","^TMP($J,""BDMLPA"",")
;Q:$G(BDMDSP) ;quit if to screen
S X=0,C=0 F S X=$O(^TMP($J,"BDMLPA",X)) Q:'X D
. N BDMGDATA
. S BDMGDATA=^TMP($J,"BDMLPA",X)
. ;I BDMGDATA="ZZZZZZZ" S BDMGDATA=$C(12)
. S ^BDMGUI(BDMIEN,11,X,0)=BDMGDATA
. S C=C+1
S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
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
;
XIT ;-- remove variables and quit
D EN^XBVK("AUPN")
D ^XBFMK,KILL^AUPNPAT
K ^TMP($J,"PATS")
Q
;
BDMVRL6 ; IHS/CMI/LAB - REPORTS INTERFACE ; [ 02/23/2009 9:13 AM ]
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,4,10,12**;JUN 14, 2007;Build 51
+2 ;VARIOUS INTERFACE CALLS FOR REPORTS
+3 ;GUI INTERFACE CODE & AND APPOINTMENT REPORTS
+4 ;
ACTIVE ;EP;TO SELECT PATIENT STATUS FOR REPORTS
+1 KILL BDMQUIT
+2 WRITE !!,"Select the Patient Status for this report"
+3 SET DIR(0)="SO^A:Active;I:Inactive;T:Transient;U:Unreviewed;D:Deceased;N:Non-IHS;NON:Noncompliant;Z:All Patients"
+4 SET DIR("A")="Select patient status"
+5 SET DIR("B")="Active"
+6 DO DIR^BDMFDIC
+7 ;IHS/CMI/TMJ Non Compliant Fix
IF Y]""
IF "AITUDNONZ"[Y
SET BDM("STATUS")=Y
+8 IF '$TEST
SET BDMQUIT=""
+9 QUIT
REPORTS ;EP;TO SELECT REPORTS
+1 SET DIR(0)="SO^1:Individual Case Summary;2:Case Summary for Multiple Patients;3:Master List of Diabetes Register Patients;4:Statistical Reports"
+2 SET DIR("A")="Which Report"
+3 WRITE !
+4 DO DIR^BDMFDIC
+5 IF 'Y
SET BDMQUIT=""
QUIT
+6 IF Y=1
DO R1
QUIT
+7 IF Y=2
DO R2
QUIT
+8 IF Y=3
DO R3
QUIT
+9 IF Y=4
DO R4
QUIT
+10 QUIT
SORT1 ;EP;TO SORT DIAGNOSIS AND COMPLICATION REPORTS
+1 WRITE !,"Sort the ",$GET(BDM("REPORT"))," Report by"
+2 SET DIR(0)="SO^1:Alpha Order by Patient;2:Alpha Order by Patient within Community;3:Alpha Order within Complication"
+3 SET DIR("A")="Which One"
+4 SET DIR("B")=1
+5 DO DIR^BDMFDIC
+6 IF 'Y
SET BDMQUIT=""
QUIT
+7 SET BDM("ORDER")=Y
+8 QUIT
R1 ;INDIVIDUAL HEALTH SUMMARY
+1 QUIT
R2 ;MULTIPLE HEALTH SUMMARY
+1 QUIT
R3 ;MASTER LIST
+1 QUIT
R4 ;STATISTICAL REPORTS
+1 QUIT
SORT ;SORT REPORTS
+1 QUIT
COMM ;SELECT COMMUNITY
+1 SET DIC="^AUTTCOM("
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which COMMUNITY: "
+4 WRITE !,"Press ENTER to include all communities)"
+5 DO DIC^BDMFDIC
+6 IF $DATA(BDMQUIT)!$DATA(BDMOUT)
SET BDMQUIT=""
QUIT
+7 IF X=""
SET BDM("COMMUNITY")="ALL"
+8 IF '$TEST
SET BDM("COMMUNITY")=+Y
+9 QUIT
PROVIDER ;EP;SELECT PROVIDER
+1 SET DIC=$SELECT(^DD(9000001,.14,0)[200:"^VA(200,",1:"^DIC(16,")
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which PROVIDER: "
+4 WRITE !,"Press ENTER to include all PROVIDERS)"
+5 DO DIC^BDMFDIC
+6 IF $DATA(BDMQUIT)!$DATA(BDMOUT)
SET BDMQUIT=""
QUIT
+7 IF X=""
SET BDM("PROVIDER")="ALL"
+8 IF '$TEST
SET BDM("PROVIDER")=+Y
+9 QUIT
A1 ;
+1 SET DIR(0)="SO^1:Active Patients Only;2:All Patients in the Register"
+2 SET DIR("A")="Which one"
+3 SET DIR("A",1)="Do you want Active patients Only"
+4 SET DIR("A")="or All Patients in the Register"
+5 SET DIR("B")="Active Patients Only"
+6 DO DIR^BDMFDIC
+7 IF Y<1
SET BDMQUIT=""
QUIT
+8 SET BDM("ACTIVE")=$SELECT(Y=1:"ACTIVE",1:"ALL")
+9 QUIT
C1 ;
+1 SET DIR(0)="SO^1:All Complications;2:One Particular Complication"
+2 SET DIR("A",1)="Do you want All Complications"
+3 SET DIR("A")="or One Particular Complication"
+4 SET DIR("B")="All Complications"
+5 WRITE !
+6 DO DIR^BDMFDIC
+7 IF Y<1
SET BDMQUIT=""
QUIT
+8 IF Y=1
SET BDM("COMPLICATION")="ALL"
QUIT
+9 IF '$TEST
DO COMP
+10 QUIT
D1 ;
+1 SET DIR(0)="SO^1:All Diagnoses;2:One Particular Diagnosis"
+2 SET DIR("A",1)="Do you want All Diagnoses"
+3 SET DIR("A")="or One Particular Diagnosis"
+4 SET DIR("B")="All Diagnoses"
+5 WRITE !
+6 DO DIR^BDMFDIC
+7 IF Y<1
SET BDMQUIT=""
QUIT
+8 IF Y=1
SET BDM("DIAGNOSIS")="ALL"
QUIT
+9 IF '$TEST
DO COMP
+10 QUIT
COMP ;SELECT COMPLICATION
+1 SET DIC="^ACM(42.1,"
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which COMPLICATION: "
+4 SET DIC("S")="I $D(^ACM(42.1,""RG"",BDMRG,+Y))"
+5 WRITE !
+6 DO DIC^BDMFDIC
+7 IF $DATA(BDMQUIT)!$DATA(BDMOUT)
SET BDMQUIT=""
QUIT
+8 IF X=""
Begin DoDot:1
+9 SET BDM("COMPLICATION")="ALL"
+10 WRITE !!,"No COMPLICATION was selected."
+11 WRITE !,"The report will include all COMPLICATIONS."
+12 HANG 2
End DoDot:1
QUIT
+13 IF '$TEST
SET BDM("COMPLICATION")=+Y
+14 QUIT
DIAG ;SELECT DIAGNOSIS
+1 SET DIC="^ACM(44.1,"
+2 SET DIC(0)="AEMQZ"
+3 SET DIC("A")="Which DIAGNOSIS: "
+4 SET DIC("S")="I $D(^ACM(44.1,""RG"",BDMRG,+Y))"
+5 WRITE !
+6 DO DIC^BDMFDIC
+7 IF $DATA(BDMQUIT)!$DATA(BDMOUT)
SET BDMQUIT=""
QUIT
+8 IF X=""
Begin DoDot:1
+9 SET BDM("DIAGNOSIS")="ALL"
+10 WRITE !!,"No DIAGNOSIS was selected."
+11 WRITE !,"The report will include all DIAGNOSES."
+12 HANG 2
End DoDot:1
QUIT
+13 IF '$TEST
SET BDM("DIAGNOSIS")=+Y
+14 QUIT
+15 DO A1
DO C1
DO SORT1
+16 QUIT
MCS ;EP;TO PRINT MULTIPLE CASE SUMMARY
+1 KILL ACMES,ACMEP,ACMPS
+2 SET (ACMEP,ACMPP,ACMRGTP)=""
+3 IF '$DATA(ACMDM)
DO ^ACMGTP
+4 SET ACMENTRY="MPS"
+5 DO ENTRY^ACMSRT
+6 QUIT
ICS ;EP;TO PRINT INDIVIDUAL CASE SUMMARY
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 KILL ACMES,ACMEP,ACMPS
+4 SET (ACMEP,ACMPP,ACMRGTP)=""
+5 IF '$DATA(ACMDM)
DO ^ACMGTP
+6 SET ACMPP=""
+7 DO QONE^ACMED
+8 QUIT
ML ;EP;TO PRINT MASTER LIST
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 KILL ACMES,ACMEP,ACMPS
+4 SET (ACMEP,ACMPP,ACMRGTP)=""
+5 IF '$DATA(ACMDM)
DO ^ACMGTP
+6 SET ACMENTRY="ML"
+7 DO ENTRY^ACMSRT
+8 QUIT
PSR ;EP;TO PRINT PATIENT AND STATISTICAL REPORTS
+1 DO REG^BDMFUTIL
+2 SET ACMDM=""
+3 IF $DATA(BDMQUIT)
QUIT
+4 KILL ACMES,ACMEP,ACMPS
+5 SET (ACMPP,ACMRGTP)=""
+6 IF '$DATA(ACMDM)
DO ^ACMGTP
+7 DO CURRENT^ACMED
+8 SET ACMPP=""
+9 SET ACMRG=BDMRDA
+10 SET ACMRGNA=BDMREGNM
+11 SET ACMCTRLP="REG;CMP;DX;FM;PROB;CR;CT"
+12 SET ACMCTRLS="CMPL;DXL;AD"
+13 DO ^ACMQK
+14 KILL ACMPP
+15 DO EN^XBVK("ACM")
DO EN^XBVK("BDM")
+16 QUIT
GENRET ;EP;TO ACCESS GENERAL RETRIEVAL (LISTER)
+1 WRITE @IOF
+2 DO REG^BDMFUTIL
+3 IF $DATA(BDMQUIT)
QUIT
+4 SET ACMRG=BDMRDA
+5 SET ACMRGNA=BDMREGNM
+6 SET ACMDM=""
+7 DO CONTROL^ACMCTRL
+8 SET ACMCTRLP=ACMCTRL
+9 DO INFORM^ACMRL01
+10 KILL ACMES,ACMEP,ACMPS
+11 SET (ACMEP,ACMPP,ACMRGTP)=""
+12 IF '$DATA(ACMDM)
DO ^ACMGTP
+13 KILL ACMPP
+14 DO ^ACMRL
+15 KILL ACMPP,ACMEP,ACMRGTP,ACMCTRLP,ACMCTRL,ACMCRTLS
+16 QUIT
APPT ;EP;TO PRINT LIST OF DM PATIENT'S APPOINTMENTS
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 DO APP1
APPEXIT KILL BDM,BDMQUIT,BDMOUT
+1 KILL ^TMP("BDMVR",$JOB)
+2 QUIT
APP1 SET BDMRDA=$ORDER(^ACM(41.1,"B",BDMREGNM,0))
+1 IF 'BDMRDA
QUIT
+2 DO ^BDMDATE
+3 IF $DATA(BDMQUIT)
QUIT
+4 ;cmi/maw 1/17/2006 so it asks for print or browse
SET BDMBROWS=1
+5 DO ZIS
+6 ;cmi/maw 1/17/2006 so variable does not hang around
KILL BDMBROWS
+7 QUIT
APPINIT ;DISPLAY APPOINTMENTS
+1 KILL ^TMP("BDMTMP",$JOB),^TMP("BDMVR",$JOB)
+2 SET (BDMJ,VALMCNT)=0
+3 DO APPHEAD
+4 NEW X,Y,Z,DFN,PAT
+5 SET BDMRPDA=0
+6 FOR
SET BDMRPDA=$ORDER(^ACM(41,"B",BDMRDA,BDMRPDA))
IF 'BDMRPDA
QUIT
Begin DoDot:1
+7 SET DFN=$PIECE($GET(^ACM(41,BDMRPDA,0)),U,2)
+8 IF '$DATA(^DPT(+DFN,"S"))
QUIT
+9 DO PAT^BDMVRL4(DFN,BDMRPDA)
+10 IF $DATA(^DPT(DFN,.35))
QUIT
+11 DO APP(DFN,BDMBEGIN,BDMEND)
End DoDot:1
+12 SET Y=""
+13 FOR
SET Y=$ORDER(^TMP("BDMTMP",$JOB,Y))
IF Y=""
QUIT
Begin DoDot:1
+14 SET Z=0
+15 FOR
SET Z=$ORDER(^TMP("BDMTMP",$JOB,Y,Z))
IF 'Z
QUIT
Begin DoDot:2
+16 SET X=^TMP("BDMTMP",$JOB,Y,Z)
+17 DO Z(X)
End DoDot:2
End DoDot:1
+18 QUIT
APP(DFN,BDMBEGIN,BDMEND) ;EP;TO LIST UPCOMING APPOINTMENTS
+1 IF '$GET(DFN)!'$GET(BDMBEGIN)!'$GET(BDMEND)
QUIT
+2 NEW X,Y,Z,PAT
+3 SET Y=BDMBEGIN-.0001
+4 SET X=""
+5 FOR
SET Y=$ORDER(^DPT(DFN,"S",Y))
IF 'Y!(BDMEND+.9999<Y)
QUIT
Begin DoDot:1
+6 SET Z=$GET(^DPT(DFN,"S",Y,0))
+7 IF Z=""
QUIT
+8 SET X=""
+9 SET (PAT,X)=$EXTRACT($PIECE($GET(^DPT(DFN,0)),U),1,20)
+10 SET $EXTRACT(X,22)=$EXTRACT($PIECE($GET(^SC(+Z,0)),U),1,20)
+11 SET DATE=Y
+12 XECUTE ^DD("DD")
+13 SET $EXTRACT(X,44)=$PIECE(Y,"@")
+14 SET $EXTRACT(X,56)="at "_$PIECE(Y,"@",2)
+15 SET BDMJ=BDMJ+1
+16 SET ^TMP("BDMTMP",$JOB,PAT,BDMJ)=X
+17 ;S X="" ;cmi/maw 1/17/2007 this should get reset prior to follow up appts
+18 IF $DATA(BDMFUAPP)
Begin DoDot:2
+19 SET Y=$EXTRACT(X,22,999)
+20 SET X=""
+21 SET $EXTRACT(X,6)="NEXT APPT: "
+22 SET $EXTRACT(X,17)=Y
End DoDot:2
+23 ;cmi/maw 9/7/06 test to see if this works for next appt.
DO Z(X)
End DoDot:1
+24 QUIT
APPHEAD ;PRINT APPOINTMENT LIST HEADER
+1 NEW X,Y,Z
+2 SET X=""
+3 SET $EXTRACT(X,10)="DIABETES MANAGEMENT SYSTEM - PATIENT APPOINTMENTS"
+4 DO Z(X)
+5 SET Y=DT
+6 XECUTE ^DD("DD")
+7 SET X=""
+8 SET $EXTRACT(X,10)="REPORT DATE....: "_Y
+9 DO Z(X)
+10 SET Y=BDMBEGIN
+11 XECUTE ^DD("DD")
+12 SET X=""
+13 SET $EXTRACT(X,10)="APPTS BEGINNING: "_Y
+14 DO Z(X)
+15 SET Y=BDMEND
+16 XECUTE ^DD("DD")
+17 SET X=""
+18 SET $EXTRACT(X,10)="APPTS ENDING...: "_Y
+19 DO Z(X)
+20 SET X=" "
+21 DO Z(X)
+22 SET X="PATIENT"
+23 SET $EXTRACT(X,22)="CLINIC"
+24 SET $EXTRACT(X,44)="APPT DATE/TIME"
+25 DO Z(X)
+26 SET X="--------------------"
+27 SET $EXTRACT(X,22)="---------------------"
+28 SET $EXTRACT(X,44)="---------------------"
+29 DO Z(X)
+30 QUIT
Z(X) ;SET TMP GLOBAL
+1 IF IO'=IO(0)
WRITE !,X
QUIT
+2 SET VALMCNT=VALMCNT+1
+3 SET ^TMP("BDMVR",$JOB,VALMCNT,0)=X
+4 QUIT
ZIS ;DEVICE INTERFACE
+1 SET ZTSAVE("BDM*")=""
+2 SET (ZTRTN,BDMRTN)="APRINT^BDMVRL6"
+3 DO ^BDMFZIS
+4 QUIT
APRINT ;EP;TO PRINT APPOINTMENT LIST
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 DO APPINIT
+4 ;cmi/maw 1/17/2006 don't browse if they select print
IF IO=IO(0)
IF '$GET(BDMPRINT)
Begin DoDot:1
+5 SET BDMHDR=""
+6 SET BDMVALM="BDM APPOINTMENT LIST"
+7 DO VALM^BDMVRL(BDMVALM)
QUIT
End DoDot:1
QUIT
+8 SET J=0
+9 FOR
SET J=$ORDER(^TMP("BDMVR",$JOB,J))
IF 'J!$DATA(BDMQUIT)
QUIT
Begin DoDot:1
+10 SET X=$GET(^TMP("BDMVR",$JOB,J,0))
+11 IF X]""
USE IO
WRITE !,X
+12 IF IOSL-4<$Y
DO PAUSE^BDMFMENU
IF $DATA(BDMQUIT)
QUIT
WRITE @IOF
SET J=J-8
DO APPHEAD
End DoDot:1
+13 QUIT
+14 ;
BDMGA(BDMRET,BDMBEGIN,BDNEND,BDMRDA,BDMGUI) ;PEP - gui call
+1 SET BDMJ=$JOB
+2 SET BDMH=$HOROLOG
+3 FOR X="BDMJ","BDMH","BDMBEGIN","BDMEND","BDMRDA"
SET @X=$GET(@X)
+4 IF $GET(BDMJ)=""
SET BDMRET=-1
QUIT
+5 IF $GET(BDMH)=""
SET BDMRET=-1
QUIT
+6 ;create entry in fileman file to hold output
+7 ;maw
NEW BDMOPT
+8 SET BDMOPT="List Patient Appointments"
+9 DO NOW^%DTC
+10 SET BDMNOW=$GET(%)
+11 KILL DD,D0,DIC
+12 SET X=DUZ_"."_BDMH
+13 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05///1;.06///"_$GET(BDMOPT)_";.07///R"
+14 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003002.4
+15 DO FILE^DICN
+16 KILL DIADD,DLAYGO,DIC,DA
+17 IF Y=-1
SET BDMRET=-1
QUIT
+18 SET BDMIEN=+Y
+19 SET BDMRET=BDMIEN
+20 DO ^XBFMK
+21 KILL ZTSAVE
SET ZTSAVE("*")=""
+22 ;D GUIEP ;for interactive testing
+23 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMVRL6"
SET ZTDESC="GUI DM LIST PATIENT APPOINTMENTS"
DO ^%ZTLOAD
+24 DO XIT
+25 QUIT
+26 ;
GUIEP ;EP - called from taskman
+1 ;D ^FUPRINT
+2 KILL ^TMP($JOB,"BDMLPA")
+3 ;cmi/maw added
SET IOM=80
+4 DO GUIR^XBLM("APPINIT^BDMVRL6","^TMP($J,""BDMLPA"",")
+5 ;Q:$G(BDMDSP) ;quit if to screen
+6 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMLPA",X))
IF 'X
QUIT
Begin DoDot:1
+7 NEW BDMGDATA
+8 SET BDMGDATA=^TMP($JOB,"BDMLPA",X)
+9 ;I BDMGDATA="ZZZZZZZ" S BDMGDATA=$C(12)
+10 SET ^BDMGUI(BDMIEN,11,X,0)=BDMGDATA
+11 SET C=C+1
End DoDot:1
+12 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+13 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+14 DO ENDLOG
+15 SET ZTREQ="@"
+16 QUIT
+17 ;
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 ;
XIT ;-- remove variables and quit
+1 DO EN^XBVK("AUPN")
+2 DO ^XBFMK
DO KILL^AUPNPAT
+3 KILL ^TMP($JOB,"PATS")
+4 QUIT
+5 ;
