AMQQPOS ;IHS/CMI/THL - POST INSTALLATION ROUTINE ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;-----
N X,Y,Z,%,%Z,A,B,I,DFN
I '$D(^AMQQ(1,1)) W !,*7,"You must restore the QMAN globals prior to running this routine!" Q
LAB I $O(^UTILITY("AMQQ",$J,"SAVE",0)) W !! D WAIT^DICD
F DA=0:0 S DA=$O(^UTILITY("AMQQ",$J,"SAVE",DA)) Q:'DA D S DIK="^AMQQ(5," D IX^DIK W "."
.F X=0:0 S X=$O(^UTILITY("AMQQ",$J,"SAVE",DA,X)) Q:'X S Y=$P(^(X),"|"),Z=$P(^(X),"|",2),@Y=Z
K ^UTILITY("AMQQ",$J,"SAVE"),X,Y,Z,DIK,DA,DIC,D
GOLD ; ENTRY POINT TO SYNC-UP V FILES
F X=0:0 S X=$O(^AMQQ(5,X)) Q:'X S Y=^(X,0),Z=$P(Y,U,12) I Z'="" D G1
I $G(^DD(9002226,0,"VR"))<4.2 W !!,"You must install the current version of the TAXONOMY File for QMAN to run properly!!!",!!,*7,*7
I '$D(^DD(9000010.09,1103)) W !!,"If you want to be able to search for lab results, install a version of",!,"the V LAB file which includes field 1103",!!,*7,*7
D BYE
EXIT K %,A,B,C,I,X,Y,Z,DFN,%Z
Q
;
G1 S (%,B)=$P(Y,U,5)
S %=$G(^AMQQ(1,%,2))
I %="" D BAD Q
I %["AUPNVXAM"!(%["AUPNVNTS") S %=$P(%,";",2) G G11 ;PATCH XXX
S A="AUPNV"_$P(Z,";")_";"
S %=+$P(%,A,2)
G11 S %Z=$P(Z,";",2)
S Z="^AUTT"_$P(Z,";")_"(""C"","""_$P(Z,";",2)_""","""")"
S Z=$O(@Z)
I Z,Z=% Q
I 'Z D BAD Q
S DFN=%
D RESET
Q
;
MSG W !,$P(Y,U)," (",X,")"
Q
;
BAD ;
W !,$P(^AMQQ(5,X,0),U)," NOT FOUND IN YOUR DATABASE"
S DIK="^AMQQ(5,"
S DA=X
D ^DIK
K DA,DIK
Q
;
RESET ; The following lines contain commands that perform hard sets
; of data global ^AMQQ - An exemption to SAC 6.1.2.3 has been approved
; by Jim McArthur per memo dated May 17, 1993. This exemption is
S $P(^AMQQ(1,B,0),U,11)=Z
I Z S $P(^(0),U,15)=Z
S A=^AMQQ(1,B,1)
I A'["IMM" S C=" I $D(^(AMQP(0),",%=$P(A,C,2),%="))"_$P(%,"))",2,999),%=Z_%,A=$P(A,C)_C_%,^AMQQ(1,B,1)=A
F I=1,2 S A=^AMQQ(1,B,I),C=$P(^AMQQ(5,X,0),U,12),C=$P(C,";") S:C="EXAM" C="XAM" S C="AUPNV"_C_";",%=$P(A,C,2),%=Z_";"_$P(%,";",2,999),A=$P(A,C)_C_%,^AMQQ(1,B,I)=A
I A["IMM" D IMM
Q
;
IMM ; Check compound immunization links to see if need to change a dfn
N %A,%B,%C,%D,%E,%F,%I,%LINK
F %I=2:1 S %A=$P($T(IMMUN+%I),";;",2) Q:%A="" D
. S %C=$P(%A,U) F I=1:1 S %D=$P(%C,":",I) Q:%D="" I %D=%Z S %LINK=$P(%A,U,2) D Q
.. F I=1,2 S A=^AMQQ(1,%LINK,I),C="AUPNVIMM;",%=$P(A,C,2),%C=$P(%,";") D S %=%C_";"_$P(%,";",2,999),A=$P(A,C)_C_%,^AMQQ(1,%LINK,I)=A
... F %E=1:1 S %F=$P(%C,":",%E) Q:%F="" I %F=DFN S $P(%C,":",%E)=Z
Q
;
BYE ; EXIT MESSAGE
W !!!,"Good news! The installation of Q-Man has been successfully completed."
W !!,"Bad news! You still have some work to do: assign keys and security codes,"
W !,"put the Q-Man options on the menu, and use the Q-Man Managers Utilities."
W !,"If you do not have written instructions, do a Fileman Inquire on the Q-Man"
W !,"entry of the package file.",!!!,*7,*7
Q
;
IMMUN ; Table of Compound Immunizations - IHS CODE:IHS CODE^QMAN LINK ENTRY
; DFNs will be changed to reflect current system state
;;02:03:04:34^180
;;02:04^186
;;03:04:34^185
;;15:17^199
;;14:17:18^198
AMQQPOS ;IHS/CMI/THL - POST INSTALLATION ROUTINE ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;-----
+3 NEW X,Y,Z,%,%Z,A,B,I,DFN
+4 IF '$DATA(^AMQQ(1,1))
WRITE !,*7,"You must restore the QMAN globals prior to running this routine!"
QUIT
LAB IF $ORDER(^UTILITY("AMQQ",$JOB,"SAVE",0))
WRITE !!
DO WAIT^DICD
+1 FOR DA=0:0
SET DA=$ORDER(^UTILITY("AMQQ",$JOB,"SAVE",DA))
IF 'DA
QUIT
Begin DoDot:1
+2 FOR X=0:0
SET X=$ORDER(^UTILITY("AMQQ",$JOB,"SAVE",DA,X))
IF 'X
QUIT
SET Y=$PIECE(^(X),"|")
SET Z=$PIECE(^(X),"|",2)
SET @Y=Z
End DoDot:1
SET DIK="^AMQQ(5,"
DO IX^DIK
WRITE "."
+3 KILL ^UTILITY("AMQQ",$JOB,"SAVE"),X,Y,Z,DIK,DA,DIC,D
GOLD ; ENTRY POINT TO SYNC-UP V FILES
+1 FOR X=0:0
SET X=$ORDER(^AMQQ(5,X))
IF 'X
QUIT
SET Y=^(X,0)
SET Z=$PIECE(Y,U,12)
IF Z'=""
DO G1
+2 IF $GET(^DD(9002226,0,"VR"))<4.2
WRITE !!,"You must install the current version of the TAXONOMY File for QMAN to run properly!!!",!!,*7,*7
+3 IF '$DATA(^DD(9000010.09,1103))
WRITE !!,"If you want to be able to search for lab results, install a version of",!,"the V LAB file which includes field 1103",!!,*7,*7
+4 DO BYE
EXIT KILL %,A,B,C,I,X,Y,Z,DFN,%Z
+1 QUIT
+2 ;
G1 SET (%,B)=$PIECE(Y,U,5)
+1 SET %=$GET(^AMQQ(1,%,2))
+2 IF %=""
DO BAD
QUIT
+3 ;PATCH XXX
IF %["AUPNVXAM"!(%["AUPNVNTS")
SET %=$PIECE(%,";",2)
GOTO G11
+4 SET A="AUPNV"_$PIECE(Z,";")_";"
+5 SET %=+$PIECE(%,A,2)
G11 SET %Z=$PIECE(Z,";",2)
+1 SET Z="^AUTT"_$PIECE(Z,";")_"(""C"","""_$PIECE(Z,";",2)_""","""")"
+2 SET Z=$ORDER(@Z)
+3 IF Z
IF Z=%
QUIT
+4 IF 'Z
DO BAD
QUIT
+5 SET DFN=%
+6 DO RESET
+7 QUIT
+8 ;
MSG WRITE !,$PIECE(Y,U)," (",X,")"
+1 QUIT
+2 ;
BAD ;
+1 WRITE !,$PIECE(^AMQQ(5,X,0),U)," NOT FOUND IN YOUR DATABASE"
+2 SET DIK="^AMQQ(5,"
+3 SET DA=X
+4 DO ^DIK
+5 KILL DA,DIK
+6 QUIT
+7 ;
RESET ; The following lines contain commands that perform hard sets
+1 ; of data global ^AMQQ - An exemption to SAC 6.1.2.3 has been approved
+2 ; by Jim McArthur per memo dated May 17, 1993. This exemption is
+3 SET $PIECE(^AMQQ(1,B,0),U,11)=Z
+4 IF Z
SET $PIECE(^(0),U,15)=Z
+5 SET A=^AMQQ(1,B,1)
+6 IF A'["IMM"
SET C=" I $D(^(AMQP(0),"
SET %=$PIECE(A,C,2)
SET %="))"_$PIECE(%,"))",2,999)
SET %=Z_%
SET A=$PIECE(A,C)_C_%
SET ^AMQQ(1,B,1)=A
+7 FOR I=1,2
SET A=^AMQQ(1,B,I)
SET C=$PIECE(^AMQQ(5,X,0),U,12)
SET C=$PIECE(C,";")
IF C="EXAM"
SET C="XAM"
SET C="AUPNV"_C_";"
SET %=$PIECE(A,C,2)
SET %=Z_";"_$PIECE(%,";",2,999)
SET A=$PIECE(A,C)_C_%
SET ^AMQQ(1,B,I)=A
+8 IF A["IMM"
DO IMM
+9 QUIT
+10 ;
IMM ; Check compound immunization links to see if need to change a dfn
+1 NEW %A,%B,%C,%D,%E,%F,%I,%LINK
+2 FOR %I=2:1
SET %A=$PIECE($TEXT(IMMUN+%I),";;",2)
IF %A=""
QUIT
Begin DoDot:1
+3 SET %C=$PIECE(%A,U)
FOR I=1:1
SET %D=$PIECE(%C,":",I)
IF %D=""
QUIT
IF %D=%Z
SET %LINK=$PIECE(%A,U,2)
Begin DoDot:2
+4 FOR I=1,2
SET A=^AMQQ(1,%LINK,I)
SET C="AUPNVIMM;"
SET %=$PIECE(A,C,2)
SET %C=$PIECE(%,";")
Begin DoDot:3
+5 FOR %E=1:1
SET %F=$PIECE(%C,":",%E)
IF %F=""
QUIT
IF %F=DFN
SET $PIECE(%C,":",%E)=Z
End DoDot:3
SET %=%C_";"_$PIECE(%,";",2,999)
SET A=$PIECE(A,C)_C_%
SET ^AMQQ(1,%LINK,I)=A
End DoDot:2
QUIT
End DoDot:1
+6 QUIT
+7 ;
BYE ; EXIT MESSAGE
+1 WRITE !!!,"Good news! The installation of Q-Man has been successfully completed."
+2 WRITE !!,"Bad news! You still have some work to do: assign keys and security codes,"
+3 WRITE !,"put the Q-Man options on the menu, and use the Q-Man Managers Utilities."
+4 WRITE !,"If you do not have written instructions, do a Fileman Inquire on the Q-Man"
+5 WRITE !,"entry of the package file.",!!!,*7,*7
+6 QUIT
+7 ;
IMMUN ; Table of Compound Immunizations - IHS CODE:IHS CODE^QMAN LINK ENTRY
+1 ; DFNs will be changed to reflect current system state
+2 ;;02:03:04:34^180
+3 ;;02:04^186
+4 ;;03:04:34^185
+5 ;;15:17^199
+6 ;;14:17:18^198
