- 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
