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