BDMVRL2 ; cmi/anch/maw - DEMO/APPTS ACTION ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51
;
;
RDINIT ;EP;TO INITIALIZE PATIENT REGISTER DATA FOR DISPLAY
D REG^BDMFUTIL
Q:$D(BDMQUIT)
Q:'$G(BDMRPDA)
D GRD^BDMVRL5
K ^TMP("BDMVR",$J)
N A,B,C,X,Y,Z
S VALMCNT=0
S X=" PATIENT: "_$G(BDM("PATIENT"))
S $E(X,60)="AGE: "_$G(BDM("AGE"))
D Z(X)
S X=" ADDRESS: "_$G(BDM("ADDRESS"))
S $E(X,60)="DOB: "_$G(BDM("DOB"))
D Z(X)
S X=" PHONE: "_$G(BDM("PHONE"))
S $E(X,60)="HRN: "_$G(BDM("HRN"))
D Z(X)
S X="PRIM CARE PROV: "_$G(BDM("PRIMARY PROVIDER"))
S $E(X,60)="RES: "_$S($G(BDM("RES")):$P($G(^AUTTCOM(+BDM("RES"),0)),U),1:$G(BDM("RES")))
D Z(X)
S X=" STATUS: "_$G(BDM("STATUS"))
D Z(X)
S X="WHERE FOLLOWED: "_$G(BDM("WHERE FOLLOWED"))
D Z(X)
S X=" REGISTER PROV: "_$G(BDM("REGISTER PROVIDER"))
D Z(X)
S X=" CASE MGR: "_$E($G(BDM("CASE MANAGER")),1,40)
D Z(X)
S X=" CONTACT: "_$G(BDM("CLIENT CONTACT"))
D Z(X)
S X=" ENTRY DATE: "_$G(BDM("INITIAL ENTRY DATE"))
S $E(X,48)="LAST EDITED: "_$G(BDM("DATE LAST EDITED"))
D Z(X)
;S X=" LAST REVIEW: "_$G(BDM("LAST REVIEW DATE"))
;S $E(X,40)="NEXT REVIEW: "_$G(BDM("NEXT REVIEW DATE"))
S J=$O(BDM("DX",0))
S X=" DIAGNOSIS: "
I 'J S X=X_"(NO DIAGNOSIS ON FILE FOR THIS PATIENT)" D Z(X)
I J D
.N Z
.S Z=0
.F S Z=$O(BDM("DX",Z)) Q:'Z D
..S X=" DIAGNOSIS: "_$P($G(BDM("DX",Z)),U)
..S $E(X,48)="ONSET DATE: "_$S($P($G(BDM("DX",Z)),U,3)]"":$P(BDM("DX",Z),U,3),1:"") ;IHS/CMI/LAB - 02/05/06
..D Z(X)
;COMMENTS ADDED P12
S X="COMMENTS:" D Z(X)
S Y=0 F S Y=$O(^ACM(41,BDMRPDA,1,Y)) Q:Y'=+Y S X=^ACM(41,BDMRPDA,1,Y,0) D Z(X)
;LOCAL OPTION 1 AND 2
S X="LOCAL OPTION: "_$$VAL^XBDIQ1(9002241,BDMRPDA,1101) D Z(X)
S X="LOCAL OPTION TEXT: "_$$VAL^XBDIQ1(9002241,BDMRPDA,1102) D Z(X)
;I '$D(BDM("COMP")) D11
;.S X=" COMPLICATIONS: (NO COMPLICATIONS LISTED FOR THIS PATIENT)"
;.D Z(X)
;N J
;S J=0
;F S J=$O(BDM("COMP",J)) Q:'J D
;.I J=1 D Q
;..S Y=$P(BDM("COMP",J),U,2)
;..S X=" COMPLICATIONS: "_$P($G(BDM("COMP",J)),U)
;..S $E(X,53)="ONSET DATE: "_Y
;..D Z(X)
;.S Y=$P(BDM("COMP",J),U,2)
;.S X=" "_$P($G(BDM("COMP",J)),U)
;.S $E(X,65)=Y
;.D Z(X)
S VALMBCK="R"
Q
Z(X) ;SET TMP NODE
S VALMCNT=VALMCNT+1
S ^TMP("BDMVR",$J,VALMCNT,0)=X
Q
DX ;EP;TO SELECT DIABETES DIAGNOSIS
W !!,"Select the Diabetes Diagnosis for this report"
S DIR(0)="SO^1:Type 1;2:Type 2;3:Type 1 & Type 2;4:Gestational DM;5:Impaired Glucose Tolerance;6:All Diagnoses"
S DIR("A")="Which Diagnosis"
S DIR("B")="All Diagnoses"
D DIR^BDMFDIC
I 'Y S BDMQUIT="" Q
S BDM("DM DIAGNOSIS")=$S(Y=1:"TYPE 1",Y=2:"TYPE 2",Y=3:"TYPE 1 & TYPE 2",Y=4:"GESTATIONAL DM",Y=5:"IMPAIRED GLUCOSE TOLERANCE",1:"")
Q
PATDX ;EP;INCLUDE PATIENTS WITH SPECIFIC DIAGNOSIS
S BDMQUIT=""
Q:'$D(^ACM(44,"D",BDMRPDA))
N X,Y,Z
S X=0
F S X=$O(^ACM(44,"D",BDMRPDA,X)) Q:'X D
.S Y=+$G(^ACM(44,X,0))
.I $P($G(^ACM(44.1,+Y,0)),U)]"",BDM("DM DIAGNOSIS")[$P(^(0),U) K BDMQUIT
Q
LMEDS ;EP;TO LIST MEDS
K BDMQUIT
D NOW^%DTC
S BDMDT=X
S Z=0
F S Z=$O(^ATXAX(+BDM("LIVER MEDS TAX"),21,Z)) Q:'Z!$D(BDMQUIT) S X=+$G(^ATXAX(+BDM("LIVER MEDS TAX"),21,Z,0)) D LM1:X
Q
LM1 ;DETERMINE IF PATIENT HAS CURRENT RX FOR TARGET MEDS
Q:'$D(^PS(55,DFN,"P",0))
S XX=0
F S XX=$O(^PS(55,DFN,"P",XX)) Q:'XX!$D(BDMQUIT) D
.S PS0=$G(^PS(55,DFN,"P",XX,0))
.Q:'PS0
.Q:'$D(^PSRX(+PS0,0)) S PSRX0=^(0)
.Q:$P(PSRX0,U,6)'=X
.Q:(($P(PSRX0,U,15)>0)&($P(PSRX0,U,15)<4)!($P(PSRX0,U,15)>5))
.Q:$P(PSRX0,U,15)=""
.Q:$P(^PSRX(+PS0,2),U,6)<BDMDT
.S BDMQUIT=""
Q
NEWPAT ;EP;CREATE ENTRY FOR NEW REGISTER PATIENT
S DIR(0)="YO"
S DIR("A",1)=" "_$P(^DPT(DFN,0),U)_" is not on"
S DIR("A",2)=" the "_$S($G(BDMREGNM)]"":BDMREGNM_$S(BDMREGNM'["REGISTER"&(BDMREGNM'["Register"):" Register",1:""),1:"DIABETES Register")
S DIR("A",3)=" "
S DIR("A")="Add this client to the Register"
S DIR("B")="NO"
W !
D DIR^BDMFDIC
I Y'=1 S BDMQUIT="" Q
S X=BDMRDA
S DIC="^ACM(41,"
S DIC(0)="L"
S DIC("DR")=".02////"_DFN_";1////A;2////"_DT_";4////"_DT
D FILE^BDMFDIC
I +Y<1 S BDMQUIT="" Q
S BDMRPDA=+Y
Q
BDMVRL2 ; cmi/anch/maw - DEMO/APPTS ACTION ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51
+2 ;
+3 ;
RDINIT ;EP;TO INITIALIZE PATIENT REGISTER DATA FOR DISPLAY
+1 DO REG^BDMFUTIL
+2 IF $DATA(BDMQUIT)
QUIT
+3 IF '$GET(BDMRPDA)
QUIT
+4 DO GRD^BDMVRL5
+5 KILL ^TMP("BDMVR",$JOB)
+6 NEW A,B,C,X,Y,Z
+7 SET VALMCNT=0
+8 SET X=" PATIENT: "_$GET(BDM("PATIENT"))
+9 SET $EXTRACT(X,60)="AGE: "_$GET(BDM("AGE"))
+10 DO Z(X)
+11 SET X=" ADDRESS: "_$GET(BDM("ADDRESS"))
+12 SET $EXTRACT(X,60)="DOB: "_$GET(BDM("DOB"))
+13 DO Z(X)
+14 SET X=" PHONE: "_$GET(BDM("PHONE"))
+15 SET $EXTRACT(X,60)="HRN: "_$GET(BDM("HRN"))
+16 DO Z(X)
+17 SET X="PRIM CARE PROV: "_$GET(BDM("PRIMARY PROVIDER"))
+18 SET $EXTRACT(X,60)="RES: "_$SELECT($GET(BDM("RES")):$PIECE($GET(^AUTTCOM(+BDM("RES"),0)),U),1:$GET(BDM("RES")))
+19 DO Z(X)
+20 SET X=" STATUS: "_$GET(BDM("STATUS"))
+21 DO Z(X)
+22 SET X="WHERE FOLLOWED: "_$GET(BDM("WHERE FOLLOWED"))
+23 DO Z(X)
+24 SET X=" REGISTER PROV: "_$GET(BDM("REGISTER PROVIDER"))
+25 DO Z(X)
+26 SET X=" CASE MGR: "_$EXTRACT($GET(BDM("CASE MANAGER")),1,40)
+27 DO Z(X)
+28 SET X=" CONTACT: "_$GET(BDM("CLIENT CONTACT"))
+29 DO Z(X)
+30 SET X=" ENTRY DATE: "_$GET(BDM("INITIAL ENTRY DATE"))
+31 SET $EXTRACT(X,48)="LAST EDITED: "_$GET(BDM("DATE LAST EDITED"))
+32 DO Z(X)
+33 ;S X=" LAST REVIEW: "_$G(BDM("LAST REVIEW DATE"))
+34 ;S $E(X,40)="NEXT REVIEW: "_$G(BDM("NEXT REVIEW DATE"))
+35 SET J=$ORDER(BDM("DX",0))
+36 SET X=" DIAGNOSIS: "
+37 IF 'J
SET X=X_"(NO DIAGNOSIS ON FILE FOR THIS PATIENT)"
DO Z(X)
+38 IF J
Begin DoDot:1
+39 NEW Z
+40 SET Z=0
+41 FOR
SET Z=$ORDER(BDM("DX",Z))
IF 'Z
QUIT
Begin DoDot:2
+42 SET X=" DIAGNOSIS: "_$PIECE($GET(BDM("DX",Z)),U)
+43 ;IHS/CMI/LAB - 02/05/06
SET $EXTRACT(X,48)="ONSET DATE: "_$SELECT($PIECE($GET(BDM("DX",Z)),U,3)]"":$PIECE(BDM("DX",Z),U,3),1:"")
+44 DO Z(X)
End DoDot:2
End DoDot:1
+45 ;COMMENTS ADDED P12
+46 SET X="COMMENTS:"
DO Z(X)
+47 SET Y=0
FOR
SET Y=$ORDER(^ACM(41,BDMRPDA,1,Y))
IF Y'=+Y
QUIT
SET X=^ACM(41,BDMRPDA,1,Y,0)
DO Z(X)
+48 ;LOCAL OPTION 1 AND 2
+49 SET X="LOCAL OPTION: "_$$VAL^XBDIQ1(9002241,BDMRPDA,1101)
DO Z(X)
+50 SET X="LOCAL OPTION TEXT: "_$$VAL^XBDIQ1(9002241,BDMRPDA,1102)
DO Z(X)
+51 ;I '$D(BDM("COMP")) D11
+52 ;.S X=" COMPLICATIONS: (NO COMPLICATIONS LISTED FOR THIS PATIENT)"
+53 ;.D Z(X)
+54 ;N J
+55 ;S J=0
+56 ;F S J=$O(BDM("COMP",J)) Q:'J D
+57 ;.I J=1 D Q
+58 ;..S Y=$P(BDM("COMP",J),U,2)
+59 ;..S X=" COMPLICATIONS: "_$P($G(BDM("COMP",J)),U)
+60 ;..S $E(X,53)="ONSET DATE: "_Y
+61 ;..D Z(X)
+62 ;.S Y=$P(BDM("COMP",J),U,2)
+63 ;.S X=" "_$P($G(BDM("COMP",J)),U)
+64 ;.S $E(X,65)=Y
+65 ;.D Z(X)
+66 SET VALMBCK="R"
+67 QUIT
Z(X) ;SET TMP NODE
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("BDMVR",$JOB,VALMCNT,0)=X
+3 QUIT
DX ;EP;TO SELECT DIABETES DIAGNOSIS
+1 WRITE !!,"Select the Diabetes Diagnosis for this report"
+2 SET DIR(0)="SO^1:Type 1;2:Type 2;3:Type 1 & Type 2;4:Gestational DM;5:Impaired Glucose Tolerance;6:All Diagnoses"
+3 SET DIR("A")="Which Diagnosis"
+4 SET DIR("B")="All Diagnoses"
+5 DO DIR^BDMFDIC
+6 IF 'Y
SET BDMQUIT=""
QUIT
+7 SET BDM("DM DIAGNOSIS")=$SELECT(Y=1:"TYPE 1",Y=2:"TYPE 2",Y=3:"TYPE 1 & TYPE 2",Y=4:"GESTATIONAL DM",Y=5:"IMPAIRED GLUCOSE TOLERANCE",1:"")
+8 QUIT
PATDX ;EP;INCLUDE PATIENTS WITH SPECIFIC DIAGNOSIS
+1 SET BDMQUIT=""
+2 IF '$DATA(^ACM(44,"D",BDMRPDA))
QUIT
+3 NEW X,Y,Z
+4 SET X=0
+5 FOR
SET X=$ORDER(^ACM(44,"D",BDMRPDA,X))
IF 'X
QUIT
Begin DoDot:1
+6 SET Y=+$GET(^ACM(44,X,0))
+7 IF $PIECE($GET(^ACM(44.1,+Y,0)),U)]""
IF BDM("DM DIAGNOSIS")[$PIECE(^(0),U)
KILL BDMQUIT
End DoDot:1
+8 QUIT
LMEDS ;EP;TO LIST MEDS
+1 KILL BDMQUIT
+2 DO NOW^%DTC
+3 SET BDMDT=X
+4 SET Z=0
+5 FOR
SET Z=$ORDER(^ATXAX(+BDM("LIVER MEDS TAX"),21,Z))
IF 'Z!$DATA(BDMQUIT)
QUIT
SET X=+$GET(^ATXAX(+BDM("LIVER MEDS TAX"),21,Z,0))
IF X
DO LM1
+6 QUIT
LM1 ;DETERMINE IF PATIENT HAS CURRENT RX FOR TARGET MEDS
+1 IF '$DATA(^PS(55,DFN,"P",0))
QUIT
+2 SET XX=0
+3 FOR
SET XX=$ORDER(^PS(55,DFN,"P",XX))
IF 'XX!$DATA(BDMQUIT)
QUIT
Begin DoDot:1
+4 SET PS0=$GET(^PS(55,DFN,"P",XX,0))
+5 IF 'PS0
QUIT
+6 IF '$DATA(^PSRX(+PS0,0))
QUIT
SET PSRX0=^(0)
+7 IF $PIECE(PSRX0,U,6)'=X
QUIT
+8 IF (($PIECE(PSRX0,U,15)>0)&($PIECE(PSRX0,U,15)<4)!($PIECE(PSRX0,U,15)>5))
QUIT
+9 IF $PIECE(PSRX0,U,15)=""
QUIT
+10 IF $PIECE(^PSRX(+PS0,2),U,6)<BDMDT
QUIT
+11 SET BDMQUIT=""
End DoDot:1
+12 QUIT
NEWPAT ;EP;CREATE ENTRY FOR NEW REGISTER PATIENT
+1 SET DIR(0)="YO"
+2 SET DIR("A",1)=" "_$PIECE(^DPT(DFN,0),U)_" is not on"
+3 SET DIR("A",2)=" the "_$SELECT($GET(BDMREGNM)]"":BDMREGNM_$SELECT(BDMREGNM'["REGISTER"&(BDMREGNM'["Register"):" Register",1:""),1:"DIABETES Register")
+4 SET DIR("A",3)=" "
+5 SET DIR("A")="Add this client to the Register"
+6 SET DIR("B")="NO"
+7 WRITE !
+8 DO DIR^BDMFDIC
+9 IF Y'=1
SET BDMQUIT=""
QUIT
+10 SET X=BDMRDA
+11 SET DIC="^ACM(41,"
+12 SET DIC(0)="L"
+13 SET DIC("DR")=".02////"_DFN_";1////A;2////"_DT_";4////"_DT
+14 DO FILE^BDMFDIC
+15 IF +Y<1
SET BDMQUIT=""
QUIT
+16 SET BDMRPDA=+Y
+17 QUIT
