Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMVRL8

BDMVRL8.m

Go to the documentation of this file. 
  1. BDMVRL8 ; cmi/anch/maw - VIEW PT RECORD & DIAGNOSIS DATA ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**12**;JUN 14, 2007;Build 51
  1.  ;
  1.  ;
  1. CDISP ;EP;DISPLAY AND EDIT DIAGNOSIS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV DIAGNOSIS"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. CADD ;EP;TO ADD DIAGNOSIS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  W !?5,"ADD Diagnosis for ",$P(BDMPAT0,U)
  1.  D CLIST
  1.  Q:'$G(BDMJ)
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Which DIAGNOSIS(S)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  Q:+Y<1
  1. B F BDMJ=1:1 S BDMX=$P(BDMY,",",BDMJ) Q:'BDMX  D CADD1:$D(BDM("DIAG",BDMX))
  1.  K BDM("DIAG")
  1.  Q
  1. CADD1 ;
  1.  S X=+BDM("DIAG",BDMX)
  1.  I $D(^ACM(44,"AC",BDMRPDA,DFN,X)) W !!,"Patient already has ",$P(^ACM(44.1,X,0),U)," as a diagnosis.  Use Edit or Delete to modify this diagnosis" D PAUSE Q
  1.  S DIC="^ACM(44,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_DFN_";.03////"_BDMRPDA_";.04////"_BDMRDA
  1.  D FILE^BDMFDIC
  1.  Q:+Y<1
  1.  S BDMCDA=+Y
  1.  D CE1
  1.  Q
  1. CEDIT ;EP;TO EDIT DIAGNOSIS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D CSEL
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  N BDMX,BDMZ
  1.  F BDMJ=1:1 S BDMX=$P(BDMY,",",BDMJ) Q:BDMX=""  I $D(BDM("DIAG",BDMX)) S BDMCDA=+$G(BDM("DIAG",BDMX)) D CE1
  1.  Q
  1. CE1 S DA=BDMCDA
  1.  S DIE="^ACM(44,"
  1.  S DR="[BDM DIAGNOSIS]"
  1.  D DDS^BDMFDIC
  1.  Q
  1. CDELETE ;EP;TO DELETE DIAGNOSIS FROM PATIENT'S DIAGNOSIS LIST
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D CSEL
  1.  I $D(BDMQUIT) K BDMQUIT Q
  1.  N BDMX,BDMZ
  1.  F BDMJ=1:1 S BDMX=$P(BDMY,",",BDMJ) Q:BDMX=""  I $D(BDM("DIAG",BDMX)) S BDMCDA=+$G(BDM("DIAG",BDMX)) D CD1
  1.  Q
  1. CD1 S DA=BDMCDA
  1.  S DIK="^ACM(44,"
  1.  D DIK^BDMFDIC
  1.  NEW BDMX,DA,DIK
  1.  S BDMX=0 F  S BDMX=$O(^ACM(44,"C",DFN,BDMX)) Q:'BDMX  D
  1.  .S DA=BDMX,DIK="^ACM(44," D IX^DIK K DA,DIK
  1.  Q
  1. CLDELETE ;EP;TO DELETE DIAGNOSIS LIST ENTRY
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K BDMQUIT
  1.  D CSEL
  1.  I $D(BDMQUIT) K BDMQUIT D BACK Q
  1.  N BDMJ,BDMX
  1.  F BDMJ=1:1 S BDMX=$P(BDMY,",",BDMJ) Q:BDMX=""  I $D(BDM("DIAG",BDMX)) D CLD1
  1.  D BACK
  1.  Q
  1. CLD1 S DA=+$G(BDM("DIAG",BDMX))
  1.  I $D(^ACM(44,"B",DA)) D  Q
  1.  .W !!,$P(BDM("DIAG",BDMX),U,2)," is being referenced and cannot be deleted."
  1.  .H 2
  1.  S DIK="^ACM(44.1,"
  1.  D DIK^BDMFDIC
  1.  Q
  1. CINIT ;EP;INITIALIZE LIST OF PATIENTS DIAGNOSIS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ^TMP("BDMVR",$J),BDMJ,BDM("TMP")
  1.  N A,B,C,X,Y,Z
  1.  S X=""
  1.  S VALMCNT=0
  1.  ;DISPLAY PROBLEM LIST FROM PCC
  1.  S X="DIABETES RELATED PROBLEMS ON THE PROBLEM LIST"
  1.  D Z(X)
  1.  S X="PROB #",$E(X,9)="DX",$E(X,20)="PROVIDER NARRATIVE",$E(X,57)="DATE OF ONSET",$E(X,72)="STATUS"
  1.  D Z(X)
  1.  S X="",$P(X,"-",80)=""
  1.  D Z(X)
  1.  N J,X,Y,Z,F,N
  1.  K BDMPLDX
  1.  D GETPLDX
  1.  I '$D(BDMPLDX) S X="None on file" D Z(X)
  1.  I $O(BDMPLDX(0)) D
  1.  .S J=0 F  S J=$O(BDMPLDX(J)) Q:J'=+J  D
  1.  ..S F=$$VALI^XBDIQ1(9000011,J,.06)
  1.  ..S N=$$VAL^XBDIQ1(9000011,J,.07)
  1.  ..S X=$S($P(^AUTTLOC(F,0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_N
  1.  ..S $E(X,9)=$$VAL^XBDIQ1(9000011,J,.01)
  1.  ..S $E(X,20)=$E($$VAL^XBDIQ1(9000011,J,.05),1,35)
  1.  ..S $E(X,57)=$$VAL^XBDIQ1(9000011,J,.13)
  1.  ..S $E(X,72)=$$VAL^XBDIQ1(9000011,J,.12)
  1.  ..D Z(X)
  1.  S X=" "
  1.  D Z(X)
  1.  S X="    Register Diagnosis"
  1.  D Z(X)
  1.  S X="    NO.  Diagnosis                       ONSET DATE"
  1.  D Z(X)
  1.  S X="    ---  ------------------------------  ----------"
  1.  D Z(X)
  1.  S A=0,C=0
  1.  F  S A=$O(^ACM(44,"C",DFN,A)) Q:'A  D
  1.  .S Y=$G(^ACM(44,A,0))
  1.  .Q:'Y
  1.  .Q:$P(Y,U,4)'=BDMRDA
  1.  .S C=C+1
  1.  .S Y=$G(^ACM(44.1,+Y,0))
  1.  .S BDM("TMP",Y,C)=A
  1.  S BDMJ=0
  1.  S A=""
  1.  F  S A=$O(BDM("TMP",A)) Q:A=""  S C=0 F  S C=$O(BDM("TMP",A,C)) Q:C'=+C  D
  1.  .S BDMJ=BDMJ+1
  1.  .S Y=BDM("TMP",A,C)
  1.  .S Y=$P($G(^ACM(44,Y,"SV")),U,2)
  1.  .X ^DD("DD")
  1.  .S X=""
  1.  .S $E(X,5)=BDMJ
  1.  .S $E(X,10)=A
  1.  .S $E(X,42)=Y
  1.  .D Z(X)
  1.  .S ONSET=Y
  1.  .S BDM("DIAG",BDMJ)=BDM("TMP",A,C)
  1. BACK S VALMBCK="R"
  1.  Q
  1. COMDISP ;EP;TO DISPLAY AND EDIT CASE COMMENTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV COMMENTS"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. COMEDIT ;EP;TO EDIT COMMENTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  D CLEAR^VALM1
  1.  S DA=BDMRPDA
  1.  S DIE="^ACM(41,"
  1.  S DR=13
  1.  D DIE^BDMFDIC
  1.  Q
  1. COMINIT ;EP;INITIALIZE LIST OF COMMENTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ^TMP("BDMVR",$J)
  1.  N X,Y,Z
  1.  S VALMCNT=0
  1.  S X="Case Comments"
  1.  D Z(X)
  1.  S X="----------------------------------------"
  1.  D Z(X)
  1.  S A=0
  1.  F  S A=$O(^ACM(41,BDMRPDA,1,A)) Q:'A  D
  1.  .S Y=$G(^ACM(41,BDMRPDA,1,A,0))
  1.  .Q:Y=""
  1.  .S X=Y
  1.  .D Z(X)
  1.  D BACK
  1.  Q
  1. CSEL ;SELECT DIAGNOSIS
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Which Diagnosis(s)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMY=Y
  1.  Q
  1. DIAGLIST ;CREATE DIAGNOSIS LIST ARRAY
  1.  K BDM("DIAGLIST"),BDM("DIAG")
  1.  S X=0
  1.  F  S X=$O(^ACM(44.1,"RG",BDMRDA,X)) Q:'X  D
  1.  .S Y=$G(^ACM(44.1,X,0))
  1.  .Q:Y=""
  1.  .S BDM("DIAGLIST",$P(Y,U))=X
  1.  S BDMJ=0
  1.  S Y=""
  1.  F  S Y=$O(BDM("DIAGLIST",Y)) Q:Y=""  D
  1.  .S BDMJ=BDMJ+1
  1.  .S BDM("DIAG",BDMJ)=BDM("DIAGLIST",Y)_U_Y
  1.  Q
  1. CLIST ;LIST ALL DIAGNOSIS
  1.  D CLEAR^VALM1
  1.  N X,Y,Z
  1.  K BDM("DIAG"),BDMJ
  1.  D DIAGLIST
  1.  I '$D(BDM("DIAG")) D  Q
  1.  .W !!,"NO DIAGNOSIS TO LIST."
  1.  .D PAUSE^BDMFMENU
  1.  W !!?5,"NO.",?10,"DIAG"
  1.  W !?5,"---",?10,"--------------------"
  1.  S X=0
  1.  F  S X=$O(BDM("DIAG",X)) Q:'X  D
  1.  .W !?5,X,?10,$P(BDM("DIAG",X),U,2)
  1.  Q
  1. GETPLDX ;
  1.  NEW T S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1.  I 'T Q
  1.  NEW D,X,I S D="",X=0 F  S X=$O(^AUPNPROB("AC",DFN,X)) Q:X'=+X  D
  1.  .Q:$P(^AUPNPROB(X,0),U,12)="D"  ;deleted problem
  1.  .S I=$P(^AUPNPROB(X,0),U)
  1.  .I $$ICD^BDMUTL(I,$P(^ATXAX(T,0),U),9) S BDMPLDX(X)="" Q
  1.  .I $P($G(^AUPNPROB(X,800)),U,1)]"",$$SNOMED^BDMUTL(2019,"PXRM DIABETES",$P(^AUPNPROB(X,800),U,1)) S BDMPLDX(X)=""
  1.  .Q
  1.  Q
  1.  ;
  1. CLINIT ;EP;TO INITIALIZE DIAGNOSIS LIST
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ^TMP("BDMVR",$J)
  1.  K BDM("DIAGLIST")
  1.  D DIAGLIST
  1.  S VALMCNT=0
  1.  S X="    Diagnosis"
  1.  D Z(X)
  1.  S X="    NO.  Diagnosis"
  1.  D Z(X)
  1.  S X="    ---  ------------------------------"
  1.  D Z(X)
  1.  S A=""
  1.  F  S A=$O(BDM("DIAGLIST",A)) Q:A=""  D
  1.  .S X=""
  1.  .S $E(X,5)=(VALMCNT-2)
  1.  .S $E(X,10)=A
  1.  .D Z(X)
  1.  .S BDM("DIAG",VALMCNT-2)=+BDM("DIAGLIST",A)
  1.  S BDMJ=VALMCNT-3
  1.  Q
  1. CLADD ;EP;TO ADD NEW DIAGNOSIS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S DIC="^ACM(44.1,"
  1.  S DIC(0)="AEMLQZ"
  1.  S DIC("A")="Name of New Diagnosis: "
  1.  W !
  1.  D DIC^BDMFDIC
  1.  Q:'+Y
  1.  S X=BDMRDA
  1.  S (DA,DA(1))=+Y
  1.  S DIC="^ACM(44.1,"_DA_",""RG"","
  1.  S DIC(0)="L"
  1.  S:'$D(^ACM(44.1,DA,"RG",0)) ^ACM(44.1,DA,"RG",0)="^9002244.11P"
  1.  D FILE^BDMFDIC
  1.  D BACK
  1.  Q
  1. CLEDIT ;EP;TO EDIT EXISTING DIAGNOSIS LIST ENTRY
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K BDMQUIT
  1.  D CSEL
  1.  I $D(BDMQUIT) K BDMQUIT D BACK Q
  1.  F BDMI=1:1 S X=$P(BDMY,",",BDMI) Q:X=""  I $G(BDM("DIAG",X)) D CLE1
  1.  D BACK
  1.  Q
  1. CLE1 W @IOF
  1.  W !,"Edit DIAGNOSIS NAME:"
  1.  S DA=+BDM("DIAG",X)
  1.  S DIE="^ACM(44.1,"
  1.  S DR=".01;1101"
  1.  W !
  1.  D FULL^VALM1
  1.  D DIE^BDMFDIC
  1.  Q
  1. CL ;EP;FOR DIAGNOSIS LIST FUNCTIONS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV DIAGNOSIS LIST"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. DL ;EP;FOR DIAGNOSIS LIST FUNCTIONS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV DIAGNOSES LIST"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. Z(X) ;SET TMP NODE
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("BDMVR",$J,VALMCNT,0)=X
  1.  Q
  1. PAUSE ;
  1.  K DIR
  1.  S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1.  Q
  1. HDR ;
  1.  S VALMSG=$$VALMSG^BDMVU
  1.  K VALMHDR
  1.  ;
  1.  S VALMHDR(1)="Make sure that the date of onset is also documented on the"
  1.  S VALMHDR(2)="patient's problem list so other clinician's can see it."
  1.  S VALMHDR(3)="Problem list entries can be modified using EHR."
  1.  Q