- 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
