AMQQPOST ;IHS/CMI/THL - POST INSTALL ROUTINE;
;;2.0;IHS PCC SUITE;**2,7**;MAY 14, 2009
;PATCH XXX
;-----
ENV ;EP
; The following line prevents the "Disable Options..." and "Move
; Routines..." questions from being asked during the install.
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPI1"),XPDDIQ("XPO1"))=0
D PRE
Q
PRE ;EP;FOR PRE-INSTALL
N X,Y,Z
F X=1,5 D
.S Y=0
.F S Y=$O(^AMQQ(X,Y)) Q:Y>999!'Y K ^AMQQ(X,Y)
.S Y="A"
.F S Y=$O(^AMQQ(X,Y)) Q:Y="" K ^AMQQ(X,Y)
Q
POST ;EP;
D DATA
F DIK="^AMQQ(1,","^AMQQ(5," D IXALL^DIK
S DA=0
F S DA=$O(^AMQQ(5,DA)) Q:'DA S X=$P(^(DA,0),U) D:X[" "
.S DIE="^AMQQ(5,"
.S DR=".01///^S X="""_$P(X," ")_""""
.D ^DIE
S DA=$O(^AUTTMSR("B","PA",0))
Q:'DA!(DA=21)
F J=1,2 D
.S X=^AMQQ(1,725,J)
.S X=$P(X,"AUPNVMSR;")_"AUPNVMSR;"_DA_$P(X,"AUPNVMSR;21",2)
.S ^AMQQ(1,725,J)=X
.I X["AMQP(0),21" S X=$P(X,"AMQP(0),")_"AMQP(0),"_DA_$P(X,"AMQP(0),21",2),^AMQQ(1,725,J)=X
Q
DATA ;EP;TO RETRIEVE QMAN DATA
N A,B,C,D,E,X,Y,Z,XX
F XX=5,1 D
.S DA=0
.F S DA=$O(^AMQQ(XX,DA)) Q:'DA!(DA>999) D
..S DIK="^AMQQ("_XX_","
..D ^DIK
S AMQQ="XPDI"
S DA=""
S X=0
F S X=$O(^XTMP(AMQQ,X)) Q:'X D
.S Y=0
.F S Y=$O(^XTMP(AMQQ,X,"BLD",Y)) Q:'Y I $G(^(Y,0))["IHS PCC SUITE" S DA=X Q
.;F S Y=$O(^XTMP(AMQQ,X,"BLD",Y)) Q:'Y I $G(^(Y,0))["AMQQ*2.0" S DA=X Q
Q:'$G(DA)
F XX=1,5 S FILE=9009070+XX D
.S A=0
.F S A=$O(^XTMP(AMQQ,DA,"DATA",FILE,A)) Q:'A D A
Q
A ;
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A))=1 S ^AMQQ(XX,A)=^(A)
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,0))=1 S ^AMQQ(XX,A,0)=^(0)
S B=0
F S B=$O(^XTMP(AMQQ,DA,"DATA",FILE,A,B)) Q:'B D B
Q
B ;
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B))=1 S ^AMQQ(XX,A,B)=^(B)
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B,0))=1 S ^AMQQ(XX,A,B,0)=^(0)
S C=0
F S C=$O(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C)) Q:'C D C
Q
C ;
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C))=1 S ^AMQQ(XX,A,B,C)=^(C)
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,0))=1 S ^AMQQ(XX,A,B,C,0)=^(0)
S D=0
F S D=$O(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D)) Q:'D D D
Q
D ;
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D))=1 S ^AMQQ(XX,A,B,C,D)=^(D)
I $D(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D,0))=1 S ^AMQQ(XX,A,B,C,D,0)=^(0)
Q
AMQQPOST ;IHS/CMI/THL - POST INSTALL ROUTINE;
+1 ;;2.0;IHS PCC SUITE;**2,7**;MAY 14, 2009
+2 ;PATCH XXX
+3 ;-----
ENV ;EP
+1 ; The following line prevents the "Disable Options..." and "Move
+2 ; Routines..." questions from being asked during the install.
+3 SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"),XPDDIQ("XPI1"),XPDDIQ("XPO1"))=0
+4 DO PRE
+5 QUIT
PRE ;EP;FOR PRE-INSTALL
+1 NEW X,Y,Z
+2 FOR X=1,5
Begin DoDot:1
+3 SET Y=0
+4 FOR
SET Y=$ORDER(^AMQQ(X,Y))
IF Y>999!'Y
QUIT
KILL ^AMQQ(X,Y)
+5 SET Y="A"
+6 FOR
SET Y=$ORDER(^AMQQ(X,Y))
IF Y=""
QUIT
KILL ^AMQQ(X,Y)
End DoDot:1
+7 QUIT
POST ;EP;
+1 DO DATA
+2 FOR DIK="^AMQQ(1,","^AMQQ(5,"
DO IXALL^DIK
+3 SET DA=0
+4 FOR
SET DA=$ORDER(^AMQQ(5,DA))
IF 'DA
QUIT
SET X=$PIECE(^(DA,0),U)
IF X[" "
Begin DoDot:1
+5 SET DIE="^AMQQ(5,"
+6 SET DR=".01///^S X="""_$PIECE(X," ")_""""
+7 DO ^DIE
End DoDot:1
+8 SET DA=$ORDER(^AUTTMSR("B","PA",0))
+9 IF 'DA!(DA=21)
QUIT
+10 FOR J=1,2
Begin DoDot:1
+11 SET X=^AMQQ(1,725,J)
+12 SET X=$PIECE(X,"AUPNVMSR;")_"AUPNVMSR;"_DA_$PIECE(X,"AUPNVMSR;21",2)
+13 SET ^AMQQ(1,725,J)=X
+14 IF X["AMQP(0),21"
SET X=$PIECE(X,"AMQP(0),")_"AMQP(0),"_DA_$PIECE(X,"AMQP(0),21",2)
SET ^AMQQ(1,725,J)=X
End DoDot:1
+15 QUIT
DATA ;EP;TO RETRIEVE QMAN DATA
+1 NEW A,B,C,D,E,X,Y,Z,XX
+2 FOR XX=5,1
Begin DoDot:1
+3 SET DA=0
+4 FOR
SET DA=$ORDER(^AMQQ(XX,DA))
IF 'DA!(DA>999)
QUIT
Begin DoDot:2
+5 SET DIK="^AMQQ("_XX_","
+6 DO ^DIK
End DoDot:2
End DoDot:1
+7 SET AMQQ="XPDI"
+8 SET DA=""
+9 SET X=0
+10 FOR
SET X=$ORDER(^XTMP(AMQQ,X))
IF 'X
QUIT
Begin DoDot:1
+11 SET Y=0
+12 FOR
SET Y=$ORDER(^XTMP(AMQQ,X,"BLD",Y))
IF 'Y
QUIT
IF $GET(^(Y,0))["IHS PCC SUITE"
SET DA=X
QUIT
+13 ;F S Y=$O(^XTMP(AMQQ,X,"BLD",Y)) Q:'Y I $G(^(Y,0))["AMQQ*2.0" S DA=X Q
End DoDot:1
+14 IF '$GET(DA)
QUIT
+15 FOR XX=1,5
SET FILE=9009070+XX
Begin DoDot:1
+16 SET A=0
+17 FOR
SET A=$ORDER(^XTMP(AMQQ,DA,"DATA",FILE,A))
IF 'A
QUIT
DO A
End DoDot:1
+18 QUIT
A ;
+1 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A))=1
SET ^AMQQ(XX,A)=^(A)
+2 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,0))=1
SET ^AMQQ(XX,A,0)=^(0)
+3 SET B=0
+4 FOR
SET B=$ORDER(^XTMP(AMQQ,DA,"DATA",FILE,A,B))
IF 'B
QUIT
DO B
+5 QUIT
B ;
+1 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B))=1
SET ^AMQQ(XX,A,B)=^(B)
+2 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B,0))=1
SET ^AMQQ(XX,A,B,0)=^(0)
+3 SET C=0
+4 FOR
SET C=$ORDER(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C))
IF 'C
QUIT
DO C
+5 QUIT
C ;
+1 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C))=1
SET ^AMQQ(XX,A,B,C)=^(C)
+2 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,0))=1
SET ^AMQQ(XX,A,B,C,0)=^(0)
+3 SET D=0
+4 FOR
SET D=$ORDER(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D))
IF 'D
QUIT
DO D
+5 QUIT
D ;
+1 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D))=1
SET ^AMQQ(XX,A,B,C,D)=^(D)
+2 IF $DATA(^XTMP(AMQQ,DA,"DATA",FILE,A,B,C,D,0))=1
SET ^AMQQ(XX,A,B,C,D,0)=^(0)
+3 QUIT
