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

BDM20P5.m

Go to the documentation of this file. 
  1. BDM20P5 ; IHS/CMI/LAB - BDM V2.0 patch 5 environment check ; 
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**5**;JUN 14, 2007
  1.  ;
  1.  ;
  1.  ; The following line prevents the "Disable Options..." and "Move
  1.  ; Routines..." questions from being asked during the install.
  1.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  I '$$INSTALLD("BDM*2.0*4") D SORRY(2)
  1.  ;require CRS?
  1.  ;
  1.  Q
  1.  ;
  1. PRE ;
  1.  S BDMX=0 F  S BDMX=$O(^BDMRECD(BDMX)) Q:BDMX'=+BDMX  S DA=BDMX,DIK="^BDMRECD(" D ^DIK
  1.  S BDMX=0 F  S BDMX=$O(^BDMDMTX(BDMX)) Q:BDMX'=+BDMX  S DA=BDMX,DIK="^BDMDMTX(" D ^DIK
  1.  S BDMX=0 F  S BDMX=$O(^BDMTAXS(BDMX)) Q:BDMX'=+BDMX  S DA=BDMX,DIK="^BDMTAXS(" D ^DIK
  1.  Q
  1. POST ;
  1.  S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM2012 AUDIT MENU","DM12",5)
  1.  I 'X W !,"Attempt to add BDM DM2012 AUDIT MENU option failed.." H 3
  1.  D MEDTAX
  1.  D LABTAX
  1.  ;copy A/C RATIO TAXONOMY
  1.  ;D UACR
  1.  D ^BDMD4X
  1.  Q
  1. UACR ;
  1.  Q:$D(^ATXLAB("B","DM AUDIT QUANT UACR"))  ;already have this taxonomy
  1.  ;add it and then move the  a/c ratio tax to this new one
  1.  S BDMX="DM AUDIT QUANT UACR",BDMPG="BDM",BDMAP=0 D LAB1
  1.  S BDMNDA=$O(^ATXLAB("B","DM AUDIT QUANT UACR",0))
  1.  S BDMODA=$O(^ATXLAB("B","DM AUDIT A/C RATIO TAX",0))
  1.  I 'BDMNDA Q
  1.  I 'BDMODA Q
  1.  M ^ATXLAB(BDMNDA,21)=^ATXLAB(BDMODA,21)
  1.  Q
  1. INSTALLD(BDMSTAL) ;EP - Determine if patch BDMSTAL was installed, where
  1.  ; APCLSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW BDMY,DIC,X,Y
  1.  S X=$P(BDMSTAL,"*",1)
  1.  S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
  1.  D IX^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",22,",X=$P(BDMSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(BDMSTAL,"*",3)
  1.  D ^DIC
  1.  S BDMY=Y
  1.  D IMES
  1.  Q $S(BDMY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_BDMSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1. SORRY(X) ;
  1.  KILL DIFQ
  1.  I X=3 S XPDQUIT=2 Q
  1.  S XPDQUIT=X
  1.  W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
  1.  Q
  1.  ;
  1. MEDTAX ;EP set up drug taxonomies
  1.  S ATXFLG=1
  1.  S BDMNDCT="",BDMTAX=""
  1.  S BDMX="DM AUDIT ASPIRIN DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT ACARBOSE DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT ACE INHIBITORS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT ANTI-PLATELET DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT DPP4 INHIBITOR DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT GLITAZONE DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT INCRETIN MIMETIC",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT INSULIN DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT LIPID LOWERING DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT METFORMIN DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT ORAL HYPOGLYCEMICS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT SELF MONITOR DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT STATIN DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT SULFONYLUREA DRUGS",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT SULFONYLUREA-LIKE",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  S BDMX="DM AUDIT AMYLIN ANALOGUES",BDMPG="APCH;BDM" D DRUG1
  1.  S BDMX="DM AUDIT FIBRATE DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT NIACIN DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT BILE ACID DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT EZETIMIBE DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT FISH OIL DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT LOVAZA DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT GLP-1 ANALOG DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT BROMOCRIPTINE DRUGS",BDMPG="BDM" D DRUG1
  1.  S BDMX="DM AUDIT COLESEVELAM DRUGS",BDMPG="BDM" D DRUG1
  1.  Q
  1.  ;
  1. DRUG1 ;
  1.  S BDMTX=$O(^ATXAX("B",BDMX,0))
  1.  I 'BDMTX D  Q:Y=-1
  1.  .D MES^XPDUTL("Creating "_BDMX_" taxonomy")
  1.  .S X=BDMX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  .I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
  1.  .S BDMTX=+Y,$P(^ATXAX(BDMTX,0),U,2)=BDMX,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,$P(^(0),U,22)=0,$P(^(0),U,4)="n",^ATXAX(BDMTX,21,0)="^9002226.02101A^0^0"
  1.  S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
  1.  D MES^XPDUTL("Updating "_BDMX_" taxonomy")
  1.  I $G(BDMTAX)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(BDMTX,21,A)) Q:A'=+A  S B=A
  1.  .S BDMC=B
  1.  .S ^ATXAX(BDMTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",BDMTAX,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,0)),U,2) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(BDMTX,21,"B",J))
  1.  ..S BDMC=BDMC+1,^ATXAX(BDMTX,21,BDMC,0)=J_U_J
  1.  I $G(BDMNDCT)]"" D
  1.  .S A=0,B="" F  S A=$O(^ATXAX(BDMTX,21,A)) Q:A'=+A  S B=A
  1.  .S BDMC=B
  1.  .S ^ATXAX(BDMTX,21,0)="^9002226.02101A^"_B_U_B
  1.  .S Z=$O(^ATXAX("B",BDMNDCT,0))
  1.  .S J=0 F  S J=$O(^PSDRUG(J)) Q:J'=+J  S C=$P($G(^PSDRUG(J,2)),U,4) I C]"",$D(^ATXAX(Z,21,"B",C)) D
  1.  ..Q:$D(^ATXAX(BDMTX,21,"B",J))
  1.  ..S BDMC=BDMC+1,^ATXAX(BDMTX,21,BDMC,0)=J_U_J
  1.  S DA=BDMTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1.  ;
  1. LABTAX ;EP
  1.  S BDMX="DM AUDIT 2 HR GTT TAX",BDMPG="BDM,APCL,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT 75GM 2HR GLUCOSE",BDMPG="BDM,APCL,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT A/C RATIO TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT AST TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT ALT TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT CHOLESTEROL TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT CREATININE TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT FASTING GLUCOSE TESTS",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT GLUCOSE TESTS TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT HDL TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT HGB A1C TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT LDL CHOLESTEROL TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT MICROALBUMINURIA TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT P/C RATIO TAX",BDMPG="BDM,APCL,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT TRIGLYCERIDE TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT URINALYSIS TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=1 D LAB1
  1.  S BDMX="DM AUDIT URINE PROTEIN TAX",BDMPG="BDM,APCL,BGP,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT SEMI QUANT UACR",BDMPG="BDM,APCL,APCH",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT TB LAB TESTS",BDMPG="BDM",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT 24HR URINE PROTEIN",BDMPG="BDM",BDMAP=0 D LAB1
  1.  Q
  1.  ;
  1. LAB1 ;
  1.  S BDMDA=$O(^ATXLAB("B",BDMX,0))
  1.  I BDMDA G UP41   ;taxonomy already exists
  1.  W !,"Creating ",BDMX," Taxonomy..."
  1.  S X=BDMX,DIC="^ATXLAB(",DIC(0)="L",DIADD=1,DLAYGO=9002228 D ^DIC K DIC,DA,DIADD,DLAYGO,I
  1.  I Y=-1 W !!,"ERROR IN CREATING ",BDMX," TAX" Q
  1.  S BDMDA=+Y,$P(^ATXLAB(BDMDA,0),U,2)=BDMX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,$P(^(0),U,22)=0,$P(^(0),U,4)="n",$P(^(0),U,11)=BDMAP
  1.  S ^ATXLAB(BDMDA,21,0)="^9002228.02101PA^0^0"
  1.  S DA=BDMDA,DIK="^ATXAX(" D IX1^DIK
  1. UP41 ;
  1.  F BDMI=1:1 S BDMPI=$P(BDMPG,",",BDMI) Q:BDMPI=""  D
  1.  .S BDMPI=$O(^DIC(9.4,"C","BDM",0))
  1.  .Q:BDMPI=""  ;NO PACKAGE
  1.  .Q:$D(^ATXLAB(BDMDA,41,"B",BDMPI))
  1.  .S X="`"_BDMPI,DIC="^ATXLAB("_BDMDA_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002228,4101,0),U,2),DA(1)=BDMDA
  1.  .D ^DIC
  1.  .I Y=-1 W !,"updating package multiple for ",BDMPI," entry ",$P(^ATXAX(BDMDA,0),U)," failed"
  1.  .K DIC,DA,Y,X
  1.  Q