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

BDM20P9.m

Go to the documentation of this file. 
  1. BDM20P9 ; IHS/CMI/LAB - BDM V2.0 patch 8 environment check ; 29 Sep 2014  12:22 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
  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*8") D SORRY(2)
  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.  S BDMX=0 F  S BDMX=$O(^BDMSNME(BDMX)) Q:BDMX'=+BDMX  S DA=BDMX,DIK="^BDMSMME(" D ^DIK
  1.  Q
  1. POST ;
  1.  D ^BDMDDX
  1.  D BMXPO
  1.  ;CREATE DM AUDIT ANTIPLT/ANTICOAG RX taxonomy, copy DM AUDIT ANTIPLATELET THERAPY
  1.  D MEDTAX
  1.  D TBHLTH
  1.  Q
  1.  ;
  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.  I $P(BDMSTAL,"*",3)="" D IMES Q 1
  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 ANTIPLT/ANTICOAG RX",BDMPG="BDM,APCH,APCL" D DRUG1
  1.  NEW BDMN,BDMO
  1.  S BDMN=$O(^ATXAX("B","DM AUDIT ANTIPLT/ANTICOAG RX",0))
  1.  S BDMO=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
  1.  I 'BDMO!('BDMN) Q
  1.  M ^ATXAX(BDMN,21)=^ATXAX(BDMO,21)
  1.  S DA=BDMN,DIK="^ATXAX(" D IX1^DIK
  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.  S BDMX="DM AUDIT NON-HDL TESTS",BDMPG="BDM",BDMAP=0 D LAB1
  1.  S BDMX="DM AUDIT QUANT UACR",BDMPG="BDM",BDMAP=0 D LAB1
  1.  Q
  1.  ;
  1. BMXPO ;-- update the RPC file
  1.  N BDMRPC
  1.  S BDMRPC=$O(^DIC(19,"B","BDMGRPC",0))
  1.  Q:'BDMRPC
  1.  D CLEAN(BDMRPC)
  1.  D GUIEP^BMXPO(.RETVAL,BDMRPC_"|BDM")
  1.  D GUIEP^BMXPO(.RETVAL,BDMRPC_"|ATX")
  1.  Q
  1.  ;
  1. BMXSCH  ;--add the search template schema
  1.  Q:$O(^BMXADO("B","CMI VIEW SORT TEMPLATE",0))
  1.  N FDA,FIENS,FERR
  1.  S FDA(90093.99,"+1,",.01)="CMI VIEW SORT TEMPLATE"
  1.  S FDA(90093.99,"+1,",.02)=.401
  1.  S FDA(90093.991,"+2,+1,",.01)=.01
  1.  S FDA(90093.991,"+2,+1,",.02)="T"
  1.  S FDA(90093.991,"+2,+1,",.03)=80
  1.  S FDA(90093.991,"+2,+1,",.04)="TEMPLATE"
  1.  D UPDATE^DIE("","FDA","FIENS","FERR(1)")
  1.  Q
  1.  ;
  1. CLEAN(APP) ;-- clean out the RPC multiple first
  1.  S DA(1)=APP
  1.  S DIK="^DIC(19,"_DA(1)_","_"""RPC"""_","
  1.  N AMHDA
  1.  S AMHDA=0 F  S AMHDA=$O(^DIC(19,APP,"RPC",AMHDA)) Q:'AMHDA  D
  1.  . S DA=AMHDA
  1.  . D ^DIK
  1.  K ^DIC(19,APP,"RPC","B")
  1.  Q
  1.  ;
  1. LAB1 ;
  1.  S BDMDC=$O(^ATXLAB("B",BDMX,0))
  1.  I BDMDC 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 BDMDC=+Y,$P(^ATXLAB(BDMDC,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(BDMDC,21,0)="^9002228.02101PA^0^0"
  1.  S DA=BDMDC,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(BDMDC,41,"B",BDMPI))
  1.  .S X="`"_BDMPI,DIC="^ATXLAB("_BDMDC_",41,",DIC(0)="L",DIC("P")=$P(^DD(9002228,4101,0),U,2),DA(1)=BDMDC
  1.  .D ^DIC
  1.  .I Y=-1 W !,"updating package multiple for ",BDMPI," entry ",$P(^ATXAX(BDMDC,0),U)," failed"
  1.  .K DIC,DA,Y,X
  1.  Q
  1. TBHLTH ;tb health factors taxonomy
  1.  S ATXFLG=1
  1.  W !,"Creating TB HF Taxonomy... "
  1.  S APCLDA=0 F  S APCLDA=$O(^ATXAX("B","DM AUDIT TB HEALTH FACTORS",APCLDA)) Q:APCLDA=""  I APCLDA S DA=APCLDA S DIK="^ATXAX(" D ^DIK K DA,DIK
  1.  S X="DM AUDIT TB HEALTH FACTORS",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DIADD,DLAYGO,DA,DR,DO,D0
  1.  I Y=-1 W !!,"ERROR IN CREATING DM AUDIT TB HLTH FACTORS TAX" Q
  1.  S APCLTX=+Y,$P(^ATXAX(APCLTX,0),U,2)="TB TX STATUS HLTH FACTORS",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=78,$P(^(0),U,13)=0,$P(^(0),U,15)=9999999.64
  1.  S ^ATXAX(APCLTX,21,0)="^9002226.02101A^0^0"
  1.  S APCLTEXT="TBHF" F APCLX=1:1:10 S X=$P($T(@APCLTEXT+APCLX),";;",2),DIC="^AUTTHF(",DIC(0)="M" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,DQ,DI,D1,D0 I $P(Y,U)>0 D
  1.  .S ^ATXAX(APCLTX,21,APCLX,0)=+Y,$P(^ATXAX(APCLTX,21,0),U,3)=APCLX,$P(^(0),U,4)=APCLX,^ATXAX(APCLTX,21,"AA",+Y,APCLX)=""
  1.  .Q
  1.  S DA=APCLTX,DIK="^ATXAX(" D IX1^DIK
  1.  Q
  1. TBHF ;
  1.  ;;TB - TX UNTREATED
  1.  ;;TB - TX INCOMPLETE
  1.  ;;TB - TX COMPLETE
  1.  ;;TB - TX UNKNOWN
  1.  ;;TB - TX IN PROGRESS
  1.  ;;TX UNTREATED
  1.  ;;TX INCOMPLETE
  1.  ;;TX COMPLETE
  1.  ;;TX UNKNOWN
  1.  ;;TX IN PROGRESS