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

BDMVRL3.m

Go to the documentation of this file. 
  1. BDMVRL3 ; cmi/anch/maw - VIEW PT RECORD CON'T ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**9,12**;JUN 14, 2007;Build 51
  1.  ;
  1.  ;
  1. CDISP ;EP;DISPLAY AND EDIT COMPLICATIONS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV COMPLICATIONS"
  1.  D VALM^BDMVRL(BDMVALM)
  1.  Q
  1. CADD ;EP;TO ADD COMPLICATION
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  W !?5,"ADD Complications for ",$P(BDMPAT0,U)
  1.  D CLIST
  1.  Q:'$G(BDMJ)
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Which COMPLICATION(S)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  Q:+Y<1
  1.  F BDMJ=1:1 S BDMX=$P(BDMY,",",BDMJ) Q:'BDMX  D CADD1:$D(BDM("COMPLICATIONS",BDMX))
  1.  K BDM("COMPLICATIONS")
  1.  Q
  1. CADD1 ;
  1.  S X=+BDM("COMPLICATIONS",BDMX)
  1.  I $D(^ACM(42,"AC",BDMRPDA,DFN,X)) W !!,"Patient already has ",$P(^ACM(42.1,X,0),U)," as a complication.  Use Edit or Delete to modify this complication." D PAUSE Q
  1.  S DIC="^ACM(42,"
  1.  S DIC(0)="L"
  1.  S DIC("DR")=".02////"_DFN_";.03////"_BDMRPDA_";.04////"_BDMRDA
  1.  D FILE^BDMFDIC
  1.  ;EDIT COMPLICATION WHEN ADDED
  1.  Q:+Y<1
  1.  S BDMCDA=+Y
  1.  D CE1
  1.  Q
  1. CEDIT ;EP;TO EDIT COMPLICATION
  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("COMP",BDMX)) S BDMCDA=+$G(BDM("COMP",BDMX)) D CE1
  1.  Q
  1. CE1 S DA=BDMCDA
  1.  S DIE="^ACM(42,"
  1.  S DR="[BDM COMPLICATIONS]"
  1.  D DDS^BDMFDIC
  1.  Q
  1. CDELETE ;EP;TO DELETE COMPLICATION FROM PATIENT'S COMPLICATION 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("COMP",BDMX)) S BDMCDA=+$G(BDM("COMP",BDMX)) D CD1
  1.  Q
  1. CD1 S DA=BDMCDA
  1.  S DIK="^ACM(42,"
  1.  D DIK^BDMFDIC
  1.  ;LOOP THROUGH AND RESET AC FOR EACH OF THIS PATIENTS COMPLICATIONS
  1.  NEW BDMX,DA,DIK
  1.  S BDMX=0 F  S BDMX=$O(^ACM(42,"C",DFN,BDMX)) Q:'BDMX  D
  1.  .S DA=BDMX,DIK="^ACM(42," D IX^DIK K DA,DIK
  1.  Q
  1. CLDELETE ;EP;TO DELETE COMPLICATION 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("COMPLICATIONS",BDMX)) D CLD1
  1.  D BACK
  1.  Q
  1. CLD1 S DA=+$G(BDM("COMPLICATIONS",BDMX))
  1.  I $D(^ACM(42,"B",DA)) D  Q
  1.  .W !!,$P(BDM("COMPLICATIONS",BDMX),U,2)," is being referenced and cannot be deleted."
  1.  .H 2
  1.  S DIK="^ACM(42.1,"
  1.  D DIK^BDMFDIC
  1.  Q
  1. CINIT ;EP;INITIALIZE LIST OF PATIENTS COMPLICATIONS
  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.  S X="    Complications"
  1.  D Z(X)
  1.  S X="    NO.  Complication                    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(42,"C",DFN,A)) Q:'A  D
  1.  .S Y=$G(^ACM(42,A,0))
  1.  .Q:'Y
  1.  .Q:$P(Y,U,4)'=BDMRDA
  1.  .S C=C+1
  1.  .S Y=$G(^ACM(42.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(42,Y,"DT")),U)
  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("COMP",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 COMPLICATION
  1.  S DIR(0)="LO^1:"_BDMJ
  1.  S DIR("A")="Which Complication(s)"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  S BDMY=Y
  1.  Q
  1. DELETE ;EP;TO DELETE A PATIENT FROM CMS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K BDMQUIT
  1.  N ACMEP,ACMPTDEL,ACMPP,ACMRGTP,ACMRGTP,ACMQUIT
  1.  D CURRENT^ACMED
  1.  S (ACMEP,ACMPTDEL,ACMPP,ACMRGTP)=""
  1.  S ACMRG=BDMRDA
  1.  S ACMRGNA=BDMREGNM
  1.  D ^ACMLPAT
  1.  D PAUSE^BDMFMENU
  1.  Q
  1. DA ;EP;TO DO THE DIABETES AUDIT
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S X="APCLD99"
  1.  X ^%ZOSF("TEST")
  1.  I $T D  Q
  1.  .S DIC("B")=BDMREGNM
  1.  .D ^APCLD99
  1.  S X="APCL DIABETES PROGRAM QA AUDIT"
  1.  S DIC="^APCLRPT("
  1.  S DIC(0)="FM"
  1.  D DIC^BDMFDIC
  1.  I Y=-1 D  Q
  1.  .W !,*7,"DIABETES PROGRAM QA AUDIT REPORT NOT AVAILABLE"
  1.  .H 2
  1.  S APCL1=+Y
  1.  S X="APCL CUMULATIVE DIABETES QA"
  1.  S DIC="^APCLRPT("
  1.  S DIC(0)="FM"
  1.  D DIC^BDMFDIC
  1.  S APCL2=$S(Y>0:+Y,1:0)
  1.  S APCLDMRG=BDMRDA
  1.  D GO^APCLDM
  1.  Q
  1. DMMEDS ;EP;TO SELECT DM MED TAXONOMY FOR DISPLAY OF DM MEDS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  N S,T,TX,X,Y,Z,BDM,BDMJ,BDMMEDS
  1.  S (T,TX)="DM AUDIT "
  1.  F  S T=$O(^ATXAX("B",T)) Q:T=""!(T'[TX)  D
  1.  .S X=0
  1.  .F  S X=$O(^ATXAX("B",T,X)) Q:'X  D
  1.  ..Q:+$P($G(^ATXAX(X,0)),U,15)'=50
  1.  ..S BDM(X)=""
  1.  S BDMTXDA=0
  1.  F  S BDMTXDA=$O(BDM(BDMTXDA)) Q:'BDMTXDA  D
  1.  .S X=0
  1.  .F  S X=$O(^ATXAX(BDMTXDA,21,X)) Q:'X  D
  1.  ..S Y=$P($G(^ATXAX(BDMTXDA,21,X,0)),U)
  1.  ..Q:'Y
  1.  ..S BDMMEDS(Y)=""
  1.  Q:'$D(BDMMEDS)
  1.  S DA=DFN
  1.  D MP1^BDMVRL1
  1.  Q
  1. RR ;EP;TO START PRINT OF REGISTER REPORTS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ACMPRV,ACMSRT,ACMGTP,ACMDM,ACMRG,ACMRGNA,ACMEP,ACMES,ACMPP,ACMPS,ACMPTNA,ACMPC,ACMRGDFN
  1.  S ACMRG=BDMRDA
  1.  S ACMRGNA=BDMREGNM
  1.  S ACMCTRLP="REG;CMP;DX;FM;PROB;CR;CT"
  1.  S ACMCTRLS="CMPL;DXL;AD"
  1.  D CURRENT^ACMED
  1.  D RP^BDMFMENU
  1.  S ACMDM=""
  1.  Q
  1. COMPLIST ;CREATE COMPLICATIONS LIST ARRAY
  1.  K BDM("COMPLIST"),BDM("COMPLICATIONS")
  1.  S X=0
  1.  F  S X=$O(^ACM(42.1,"RG",BDMRDA,X)) Q:'X  D
  1.  .S Y=$G(^ACM(42.1,X,0))
  1.  .Q:Y=""
  1.  .S BDM("COMPLIST",$P(Y,U))=X
  1.  S BDMJ=0
  1.  S Y=""
  1.  F  S Y=$O(BDM("COMPLIST",Y)) Q:Y=""  D
  1.  .S BDMJ=BDMJ+1
  1.  .S BDM("COMPLICATIONS",BDMJ)=BDM("COMPLIST",Y)_U_Y
  1.  Q
  1. CLIST ;LIST ALL COMPLICATIONS
  1.  D CLEAR^VALM1
  1.  N X,Y,Z
  1.  K BDM("COMPLICATIONS"),BDMJ
  1.  D COMPLIST
  1.  I '$D(BDM("COMPLICATIONS")) D  Q
  1.  .W !!,"NO COMPLICATIONS TO LIST."
  1.  .D PAUSE^BDMFMENU
  1.  W !!?5,"NO.",?10,"COMPLICATION"
  1.  W !?5,"---",?10,"--------------------"
  1.  S X=0
  1.  F  S X=$O(BDM("COMPLICATIONS",X)) Q:'X  D
  1.  .W !?5,X,?10,$P(BDM("COMPLICATIONS",X),U,2)
  1.  Q
  1. CLINIT ;EP;TO INITIALIZE COMPLICATIONS LIST
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  K ^TMP("BDMVR",$J)
  1.  K BDM("COMPLIST")
  1.  N J,X,Y,Z
  1.  D COMPLIST
  1.  S VALMCNT=0
  1.  S X="    Complications"
  1.  D Z(X)
  1.  S X="    NO.  Complication"
  1.  D Z(X)
  1.  S X="    ---  ------------------------------"
  1.  D Z(X)
  1.  S A=""
  1.  F  S A=$O(BDM("COMPLIST",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("COMP",VALMCNT-2)=+BDM("COMPLIST",A)
  1.  S BDMJ=VALMCNT-3
  1.  Q
  1. CLADD ;EP;TO ADD NEW COMPLICATION
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S DIC="^ACM(42.1,"
  1.  S DIC(0)="AEMLQZ"
  1.  S DIC("A")="Name of New Complication: "
  1.  W !
  1.  D DIC^BDMFDIC
  1.  Q:'+Y
  1.  S X=BDMRDA
  1.  S (DA,DA(1))=+Y
  1.  S DIC="^ACM(42.1,"_DA_",""RG"","
  1.  S DIC(0)="L"
  1.  S:'$D(^ACM(42.1,DA,"RG",0)) ^ACM(42.1,DA,"RG",0)="^9002242.11P"
  1.  D FILE^BDMFDIC
  1.  D BACK
  1.  Q
  1. CLEDIT ;EP;TO EDIT EXISTING COMPLICATIONS 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("COMPLICATIONS",X)) D CLE1
  1.  D BACK
  1.  Q
  1. CLE1 W @IOF
  1.  W !,"Edit COMPLICATION NAME:"
  1.  S DA=+BDM("COMPLICATIONS",X)
  1.  S DIE="^ACM(42.1,"
  1.  S DR=".01;1101"
  1.  W !
  1.  D FULL^VALM1  ;LIST MANAGER
  1.  D DIE^BDMFDIC
  1.  Q
  1. CL ;EP;FOR COMPLICATIONS LIST FUNCTIONS
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  S BDMVALM="BDMV COMPLICATIONS 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. USER ;EP;TO SETUP DMS USER
  1.  D REG^BDMFUTIL
  1.  Q:$D(BDMQUIT)
  1.  F  D U1 Q:$D(BDMQUIT)!$D(BDMOUT)
  1.  K BDMQUIT,BDMOUT
  1.  Q
  1. U1 S DIR(0)="SO^1:Add/Remove DMS Authorized User;2:List Current DMS Authorized Users"
  1.  S DIR("A")="Which one"
  1.  D DIR^BDMFDIC
  1.  I Y<1 S BDMQUIT="" Q
  1.  I Y=1 D UNEW Q
  1.  I Y=2 D ULIST Q
  1.  Q
  1. UNEW ;ADD NEW DMS USER
  1.  S DIC="^VA(200,"
  1.  S DIC(0)="AEMQZ"
  1.  S DIC("A")="Select NEW DMS User: "
  1.  W !
  1.  D DIC^BDMFDIC
  1.  I +Y<1 S BDMQUIT="" Q
  1.  S BDMUSER=+Y
  1.  S BDMUNAM=$P($G(^VA(200,+Y,0)),U)
  1.  I $D(^ACM(41.1,BDMRDA,"AU",+Y)) D AU Q
  1.  S (DINUM,X)=+Y
  1.  S (DA,DA(1))=BDMRDA
  1.  S DIC="^ACM(41.1,"_DA_",""AU"","
  1.  S DIC(0)="L"
  1.  S:'$D(^ACM(41.1,DA,"AU",0)) ^ACM(41.1,DA,"AU",0)="^9002241.12P"
  1.  D FILE^BDMFDIC
  1.  S BDMX="BDMZMENU"
  1.  S BDMZ=""
  1.  D AU11
  1. AU I $D(^ACM(41.1,BDMRDA,"AU",BDMUSER)) D
  1.  .W !!,BDMUNAM," is now an Authorized User"
  1.  .W !,"of the Diabetes Managment System."
  1.  S DIR(0)="YO"
  1.  S DIR("A",1)="Do you wish to REMOVE "_BDMUNAM_" as an Authorized User"
  1.  S DIR("A")="of the Diabetes Management System"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I Y=1 D  Q
  1.  .S DA=BDMUSER
  1.  .S DA(1)=BDMRDA
  1.  .S DIK="^ACM(41.1,"_DA(1)_",""AU"","
  1.  .D DIK^BDMFDIC
  1.  .S X=$O(^DIC(19.1,"B","BDMZ REGISTER MAINTENANCE",0))
  1.  .S BDMZ=$O(^VA(200,BDMUSER,51,"B",+X,0))
  1.  .I BDMZ D AUR
  1.  .Q
  1.  S X=$O(^DIC(19.1,"B","BDMZ REGISTER MAINTENANCE",0))
  1.  S BDMZ=$O(^VA(200,BDMUSER,51,"B",+X,0))
  1.  S DIR(0)="YO"
  1.  S:'BDMZ DIR("A")="Allow "_BDMUNAM
  1.  S:BDMZ DIR("A")="Remove "_BDMUNAM_"'s"
  1.  S DIR("A")=DIR("A")_" REGISTER MANAGER AUTHORITY"
  1.  S DIR("B")="NO"
  1.  W !
  1.  D DIR^BDMFDIC
  1.  I BDMZ,Y D AUR
  1. AU1 F BDMX="BDMZMENU","BDMZ REGISTER MAINTENANCE" D AU11
  1.  Q
  1. AUR ;REMOVE KEY
  1.  S DA(1)=BDMUSER,DA=BDMZ,DIK="^VA(200,"_DA(1)_",51,"
  1.  D ^DIK
  1.  Q
  1. AU11 S X=$O(^DIC(19.1,"B",BDMX,0))
  1.  S (DIC,DIK)="^VA(200,"_BDMUSER_",51,"
  1.  S DIC(0)="L"
  1.  S DA(1)=BDMUSER
  1.  S:BDMZ DA=$O(^VA(200,BDMUSER,51,"B",+X,0))
  1.  S $P(^VA(200,BDMUSER,51,0),U,2)="200.051P"
  1.  D FILE^BDMFDIC:'BDMZ
  1.  Q
  1. ULIST ;LIST DMS USERS
  1.  W:$D(IOF) @IOF
  1.  W !?5,"Current DMS Authorized Users",?35,"Manager Authority"
  1.  W !?5,"----------------------------",?35,"-----------------"
  1.  N BDMX,BDMY,BDMZ
  1.  S BDMZ=$O(^DIC(19.1,"B","BDMZ REGISTER MAINTENANCE",0))
  1.  S BDMX=0
  1.  F  S BDMX=$O(^ACM(41.1,BDMRDA,"AU",BDMX)) Q:'BDMX  D
  1.  .S BDMY=$P($G(^VA(200,BDMX,0)),U)
  1.  .I BDMZ,BDMY]"" S BDMX(BDMY)=$D(^VA(200,BDMX,51,"B",BDMZ))
  1.  S BDMX=""
  1.  F  S BDMX=$O(BDMX(BDMX)) Q:BDMX=""!$D(BDMQUIT)  D
  1.  .W !?5,BDMX,?35
  1.  .W:BDMX(BDMX) "YES"
  1.  .I $Y>(IOSL-2) D PAUSE^BDMFMENU W:$D(IOF) @IOF
  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