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

BDWPRE.m

Go to the documentation of this file. 
  1. BDWPRE ; IHS/CMI/LAB - PRE/POST INIT ;
  1.  ;;1.0;IHS DATA WAREHOUSE;;JAN 23, 2006
  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.  I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
  1.  F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
  1.  I '$$INSTALLD("AVA*93.2*18") D SORRY(2)
  1.  I '$$INSTALLD("AUPN*99.1*14") D SORRY(2)
  1.  ;I '$$INSTALLD("APCL*3.0*16") D SORRY(2)
  1.  ;I '$$INSTALLD("ATX*5.1*6") D SORRY(2)
  1.  I '$$INSTALLD("XB*3.0*10") D SORRY(2)
  1.  I '$$INSTALLD("AUM*5.1*8") D SORRY(2)
  1.  I '$$INSTALLD("GIS*3.01*11") D SORRY(2)
  1.  Q
  1.  ;
  1. PRE ;EP - pre init
  1.  ;clean up old BDW stuff.
  1.  ;delete 90210 and data
  1.  D BMES^XPDUTL("Beginning Pre-install routine (PRE^BDWPRE).")
  1.  D MES^XPDUTL("hold on....removing old data warehouse export file....be patient")
  1.  S DIU=90213,DIU(0)="" D EN^DIU2
  1.  S DIU=90214,DIU(0)="" D EN^DIU2
  1.  S DIU=90210,DIU(0)="DT" D EN^DIU2
  1.  S DIU=90211,DIU(0)="DT" D EN^DIU2
  1.  S DIU=90219,DIU(0)="DT" D EN^DIU2
  1.  D MES^XPDUTL("killing old ADW xref on Visit file....please be patient...")
  1.  K ^AUPNVSIT("ADW")
  1.  D MES^XPDUTL("Deleting dd fields....")
  1.  NEW DIK
  1.  ;
  1.  ;delete ADWO if this is first time install
  1.  I $P($G(^BDWSITE(1,0)),U,2)="" K ^AUPNVSIT("ADWO")
  1.  D MES^XPDUTL("Pre-install routine is complete.")
  1.  Q
  1.  ;
  1. POST ;EP - post init to set up site file
  1.  I $P($G(^BDWSITE(1,0)),U,2)="" D
  1.  .S DA=1,DIK="^BDWSITE(" D ^DIK  ;delete old site file
  1.  .S ^BDWSITE(1,0)=$P(^AUTTSITE(1,0),U),^BDWSITE("B",$P(^AUTTSITE(1,0),U),1)="",$P(^BDWSITE(0),U,3)=1,$P(^BDWSITE(0),U,4)=1,$P(^BDWSITE(1,0),U,2)=DT
  1.  .S DA=1,DIK="^BDWSITE(" D IX1^DIK
  1.  .K ^AUPNVSIT("ADWO")  ;only on first install
  1. CNT .;count # of visits since 10/1/00
  1.  .D MES^XPDUTL("Counting the number of visits for backloading.  This may take awhile.")
  1.  .D MES^XPDUTL("Please be patient.")
  1.  .S (C,X)=0,D=3001001 F  S D=$O(^AUPNVSIT("B",D)) Q:D'=+D!($P(D,".")>$P(^BDWSITE(1,0),U,2))  D
  1.  ..S V=0 F  S V=$O(^AUPNVSIT("B",D,V)) Q:V'=+V  D
  1.  ...Q:'$D(^AUPNVSIT(V,0))  ;no 0 node
  1.  ...Q:$P(^AUPNVSIT(V,0),U,11)
  1.  ...Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  ...;Q:$P(^AUPNVSIT(V,0),U,23)=.5  ;no MFI created visits
  1.  ...S X=$P(^AUPNVSIT(V,0),U,6)
  1.  ...I 'X Q
  1.  ...S X=$P($G(^AUTTLOC(X,0)),U,10) I $E(X,1)=3,$P(^AUPNVSIT(V,0),U,23)=.5 Q
  1.  ...S C=C+1
  1.  ...I '(C#10000),'$D(ZTQUEUED) W ".",C
  1.  ..Q
  1.  .S $P(^BDWSITE(1,0),U,5)=C
  1. LAB ;
  1.  S BDWX="BDW PAP SMEAR LAB TESTS" D LAB1
  1.  S BDWX="BDW PSA TESTS TAX" D LAB1
  1. ZISH ;create entry in ZISH SEND PARAMETERS file
  1.  D ^XBFMK K DIADD,DLAYGO,DIC,DD,D0,DO
  1.  S BDWY=0 F  S BDWY=$O(^%ZIB(9888888.93,"B","DATA WAREHOUSE SEND",0)) Q:BDWY'=+BDWY  D
  1.  .I BDWY S DA=BDWY,DIK="^%ZIB(9888888.93," D ^DIK K DA,DIK
  1.  S X="DATA WAREHOUSE SEND",DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
  1.  I Y=-1 W !!,"error creating ZISH SEND PARAMETERS entry" Q
  1.  S DA=+Y,DIE="^%ZIB(9888888.93,",DR=".02///QUOVADX-IE.DOMAIN.NAME;.03///dwxfer;.04///regpcc;.06///-u;.07///B;.08///sendto"
  1.  D ^DIE
  1.  I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry" Q
  1.  ;D ^XBFMK K DIADD,DLAYGO,DIC,DD,D0,DO
  1.  ;S BDWY=$O(^%ZIB(9888888.93,"B","DATA WAREHOUSE SEND UNIX",0))
  1.  ;I BDWY S DA=BDWY,DIK="^%ZIB(9888888.93," D ^DIK K DA,DIK
  1.  ;S X="DATA WAREHOUSE SEND UNIX",DIC(0)="L",DIC="^%ZIB(9888888.93," D FILE^DICN
  1.  ;I Y=-1 W !!,"error creating ZISH SEND PARAMETERS UNIX entry" Q
  1.  ;S DA=+Y,DIE="^%ZIB(9888888.93,",DR=".02///QUOVADX-IE.DOMAIN.NAME;.03///dwxfer;.04///regpcc;.06///-u;.07///B;.08///sendto1"
  1.  ;D ^DIE
  1.  ;I $D(Y) W !!,"error updating ZISH SEND PARAMETERS entry" Q
  1.  D ^XBFMK
  1.  Q
  1. LAB1 ;
  1.  W !,"Creating ",BDWX," Taxonomy..."
  1.  S BDWDA=$O(^ATXLAB("B",BDWX,0))
  1.  Q:BDWDA  ;taxonomy already exisits
  1.  S X=BDWX,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 ",BDWX," TAX" Q
  1.  S BDWTX=+Y,$P(^ATXLAB(BDWTX,0),U,2)=BDWX,$P(^(0),U,5)=DUZ,$P(^(0),U,6)=DT,$P(^(0),U,8)="B",$P(^(0),U,9)=60,^ATXLAB(BDWTX,21,0)="^9002228.02101PA^0^0"
  1.  S DA=BDWTX,DIK="^ATXAX(" D IX1^DIK
  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. INSTALLD(AUPNSTAL) ;EP - Determine if patch AUPNSTAL was installed, where
  1.  ; AUPNSTAL is the name of the INSTALL.  E.g "AG*6.0*11".
  1.  ;
  1.  NEW AUPNY,DIC,X,Y
  1.  S X=$P(AUPNSTAL,"*",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(AUPNSTAL,"*",2)
  1.  D ^DIC
  1.  I Y<1 D IMES Q 0
  1.  S DIC=DIC_+Y_",""PAH"",",X=$P(AUPNSTAL,"*",3)
  1.  D ^DIC
  1.  S AUPNY=Y
  1.  D IMES
  1.  Q $S(AUPNY<1:0,1:1)
  1. IMES ;
  1.  D MES^XPDUTL($$CJ^XLFSTR("Patch """_AUPNSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
  1.  Q
  1.  ;