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