AMQQSL ; IHS/CMI/THL - UTILITY FOR EXPORT/IMPORT SCRIPTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
;
EXPORT(AMQQSDA,AMQQSNAM,AMQQOF,AMQQIF) ;EP;
;TO EXPORT QMAN QUERY FROM QUERY CLONING
;AMQQSDA - IEN OF THE QMAN SCRIPT
;AMQQSNAM - NAME OF THE QMAN SCRIPT
;AMQQOF - NAME OF THE OUTPUT FILE
;AMQQIF - NAME OF THE INPUT FILE
I AMQQSDA=""!(AMQQSNAM="")!(AMQQOF="")!(AMQQIF="") S BQCERR="Missing data for Qman Query Export" Q
D REAL
N X,Y,Z
U IO W AMQQIF,!
U IO W AMQQSNAM,!
S X=0
F S X=$O(^AMQQ(2,AMQQSDA,2,X)) Q:'X D
.S Y=$G(^AMQQ(2,AMQQSDA,2,X,0))
.Q:Y=""
.U IO W Y,!
U IO W "**",!
Q
IMPORT() ;EP;TO IMPORT AND RUN SCRIPT FROM QUERY CLONING
N AMQQH
S AMQQH=$H
I '$D(ZTQUEUED) U 0 W !!,"One moment please..."
U IO R X:1
Q:X=""!(X="**") ""
S ^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,"FILE NAME")=X
U IO R X:1
Q:X=""!(X="**") ""
S ^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,"SCRIPT NAME")=X_"-QC"
S I=0
F R X:1 Q:X=""!(X="**") D
.S I=I+1
.S ^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,I)=X
Q:'$D(^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH))
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
S X=^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,"SCRIPT NAME")
S DIC="^AMQQ(2,"
S DIC(0)="L"
S DIC("DR")="4////"_^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,"FILE NAME")
D FILE^DICN
K DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
Q:+Y<1 ""
S AMQQSDA=+Y
S (X,I)=0
F S X=$O(^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,X)) Q:'X D
.Q:$G(^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,X))=""
.S ^AMQQ(2,AMQQSDA,2,X,0)=^TMP("AMQQ EXTERNAL SCRIPT",$J,AMQQH,X)
.S I=X
S ^AMQQ(2,AMQQSDA,2,0)="^^"_I_U_I_U_DT
I '$D(ZTQUEUED) U 0 W !!,"QMAN File import completed."
D POINTER
Q AMQQSDA
;
REPORT(AMQQSDA) ;EP;RUN QMAN SCRIPT FROM QUERY CLONING
;AMQQSDA - IEN OF QMAN SCRIPT
;AMQQFILE - HOST FILE NAME FOR THE SCRIPT
S AMQQFILE=$$IFILE(AMQQSDA)
Q:AMQQFILE="" ""
S AMQQYY=AMQQSDA
K AMQV,^UTILITY("AMQQ",$J),^UTILITY("AMQQ TAX",$J)
D RESTORE^AMQQCMPS
Q:'$D(AMQV(1)) ""
S AMQQCCLS=$E($P(AMQV(0),"AMQQCCLS=""",2))
S AMQV("OPTION")="LIST"
D DOIT^AMQQCMPL
Q AMQQFILE
;
IFILE(AMQQSDA) ;EP;TO DETERMINE THE NAME OF THE HOST FILE TO BE CREATED FOR THE
;QMAN REPORT
;AMQQSDA - IEN OF QMAN SCRIPT
S AMQQFILE=$P($G(^AMQQ(2,+AMQQSDA,0)),U,4)
Q AMQQFILE
;
REAL ;CONVERT SCRIPT POINTER VALUES TO REAL VALUES
N X,Y,Z,ZZ
K ^TMP("QMAN SCRIPT",$J)
S X=0
F S X=$O(^AMQQ(2,AMQQSDA,2,X)) Q:'X S Y=$G(^(X,0)) D:$E(Y)="T"!($E(Y)="V")
.Q:$P(Y,";",2)=""!'$P(Y,";",3)
.I Y["T;",$P(Y,U,2)]"" Q
.S ^TMP("QMAN SCRIPT",$J,$E(Y),$P(Y,";",2),+$P(Y,";",3))=X
S (Z,X)=0
F S X=$O(^TMP("QMAN SCRIPT",$J,"T",X)) Q:'X D
.S Z=$O(^TMP("QMAN SCRIPT",$J,"V",Z))
.Q:'Z
.S Z=$O(^TMP("QMAN SCRIPT",$J,"V",Z,0))
.Q:'$P($G(^AMQQ(1,+Z,0)),U,4) S F=$P(^(0),U,4),Z=$P(^(0),U,3)
.Q:'Z!'F
.S Z=$G(^DD(Z,F,0))
.Q:$P(Z,U,2)'["P"
.S Z=$P(Z,U,3)
.S Z=U_$S($E(Z,$L(Z))="(":$P(Z,"("),1:$E(Z,1,$L(Z)-1)_")")
.S Y=0
.F S Y=$O(^TMP("QMAN SCRIPT",$J,"T",X,Y)) Q:'Y S ZZ=^(Y) D
..Q:'$D(@Z@(Y,0)) S %=$P(^(0),U)
..S ^AMQQ(2,AMQQSDA,2,ZZ,0)=^AMQQ(2,AMQQSDA,2,ZZ,0)_U_%
Q
POINTER ;CONVERT SCRIPT REAL VALUES TO POINTER VALUES
N X,Y,Z,ZZ
K ^TMP("QMAN SCRIPT",$J)
S X=0
F S X=$O(^AMQQ(2,AMQQSDA,2,X)) Q:'X S Y=$G(^(X,0)) D:$E(Y)="T"!($E(Y)="V")
.Q:$P(Y,";",2)=""!($P(Y,";",3)="")
.S ^TMP("QMAN SCRIPT",$J,$E(Y),$P(Y,";",2),$P($P(Y,";",3),U))=X_U_$P(Y,U,2)
S X=0
F S X=$O(^TMP("QMAN SCRIPT",$J,"T",X)) Q:'X D
.S Y=0
.F S Y=$O(^TMP("QMAN SCRIPT",$J,"T",X,Y)) Q:'Y S ZZ=^(Y) D
..S Z=X+9
..S Z=$O(^TMP("QMAN SCRIPT",$J,"V",Z,0))
..Q:'$P($G(^AMQQ(1,+Z,0)),U,4) S F=$P(^(0),U,4),Z=$P(^(0),U,3)
..Q:'Z!'F
..S Z=$G(^DD(Z,F,0))
..Q:$P(Z,U,2)'["P"
..S Z=$P(Z,U,3)
..S Z=U_$S($E(Z,$L(Z))="(":$P(Z,"("),1:$E(Z,1,$L(Z)-1)_")")
..S XREF=$S(Z'["ICD9":"B",1:"AB")
..S Z=$O(@Z@(XREF,$P(ZZ,U,2),0))
..Q:'Z
..S $P(^AMQQ(2,AMQQSDA,2,+ZZ,0),";",3)=Z
Q
AMQQSL ; IHS/CMI/THL - UTILITY FOR EXPORT/IMPORT SCRIPTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
+3 ;
EXPORT(AMQQSDA,AMQQSNAM,AMQQOF,AMQQIF) ;EP;
+1 ;TO EXPORT QMAN QUERY FROM QUERY CLONING
+2 ;AMQQSDA - IEN OF THE QMAN SCRIPT
+3 ;AMQQSNAM - NAME OF THE QMAN SCRIPT
+4 ;AMQQOF - NAME OF THE OUTPUT FILE
+5 ;AMQQIF - NAME OF THE INPUT FILE
+6 IF AMQQSDA=""!(AMQQSNAM="")!(AMQQOF="")!(AMQQIF="")
SET BQCERR="Missing data for Qman Query Export"
QUIT
+7 DO REAL
+8 NEW X,Y,Z
+9 USE IO
WRITE AMQQIF,!
+10 USE IO
WRITE AMQQSNAM,!
+11 SET X=0
+12 FOR
SET X=$ORDER(^AMQQ(2,AMQQSDA,2,X))
IF 'X
QUIT
Begin DoDot:1
+13 SET Y=$GET(^AMQQ(2,AMQQSDA,2,X,0))
+14 IF Y=""
QUIT
+15 USE IO
WRITE Y,!
End DoDot:1
+16 USE IO
WRITE "**",!
+17 QUIT
IMPORT() ;EP;TO IMPORT AND RUN SCRIPT FROM QUERY CLONING
+1 NEW AMQQH
+2 SET AMQQH=$HOROLOG
+3 IF '$DATA(ZTQUEUED)
USE 0
WRITE !!,"One moment please..."
+4 USE IO
READ X:1
+5 IF X=""!(X="**")
QUIT ""
+6 SET ^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,"FILE NAME")=X
+7 USE IO
READ X:1
+8 IF X=""!(X="**")
QUIT ""
+9 SET ^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,"SCRIPT NAME")=X_"-QC"
+10 SET I=0
+11 FOR
READ X:1
IF X=""!(X="**")
QUIT
Begin DoDot:1
+12 SET I=I+1
+13 SET ^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,I)=X
End DoDot:1
+14 IF '$DATA(^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH))
QUIT
+15 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+16 SET X=^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,"SCRIPT NAME")
+17 SET DIC="^AMQQ(2,"
+18 SET DIC(0)="L"
+19 SET DIC("DR")="4////"_^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,"FILE NAME")
+20 DO FILE^DICN
+21 KILL DIE,DIC,DINUM,DR,DA,DD,DO,DIK,DLAYGO
+22 IF +Y<1
QUIT ""
+23 SET AMQQSDA=+Y
+24 SET (X,I)=0
+25 FOR
SET X=$ORDER(^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,X))
IF 'X
QUIT
Begin DoDot:1
+26 IF $GET(^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,X))=""
QUIT
+27 SET ^AMQQ(2,AMQQSDA,2,X,0)=^TMP("AMQQ EXTERNAL SCRIPT",$JOB,AMQQH,X)
+28 SET I=X
End DoDot:1
+29 SET ^AMQQ(2,AMQQSDA,2,0)="^^"_I_U_I_U_DT
+30 IF '$DATA(ZTQUEUED)
USE 0
WRITE !!,"QMAN File import completed."
+31 DO POINTER
+32 QUIT AMQQSDA
+33 ;
REPORT(AMQQSDA) ;EP;RUN QMAN SCRIPT FROM QUERY CLONING
+1 ;AMQQSDA - IEN OF QMAN SCRIPT
+2 ;AMQQFILE - HOST FILE NAME FOR THE SCRIPT
+3 SET AMQQFILE=$$IFILE(AMQQSDA)
+4 IF AMQQFILE=""
QUIT ""
+5 SET AMQQYY=AMQQSDA
+6 KILL AMQV,^UTILITY("AMQQ",$JOB),^UTILITY("AMQQ TAX",$JOB)
+7 DO RESTORE^AMQQCMPS
+8 IF '$DATA(AMQV(1))
QUIT ""
+9 SET AMQQCCLS=$EXTRACT($PIECE(AMQV(0),"AMQQCCLS=""",2))
+10 SET AMQV("OPTION")="LIST"
+11 DO DOIT^AMQQCMPL
+12 QUIT AMQQFILE
+13 ;
IFILE(AMQQSDA) ;EP;TO DETERMINE THE NAME OF THE HOST FILE TO BE CREATED FOR THE
+1 ;QMAN REPORT
+2 ;AMQQSDA - IEN OF QMAN SCRIPT
+3 SET AMQQFILE=$PIECE($GET(^AMQQ(2,+AMQQSDA,0)),U,4)
+4 QUIT AMQQFILE
+5 ;
REAL ;CONVERT SCRIPT POINTER VALUES TO REAL VALUES
+1 NEW X,Y,Z,ZZ
+2 KILL ^TMP("QMAN SCRIPT",$JOB)
+3 SET X=0
+4 FOR
SET X=$ORDER(^AMQQ(2,AMQQSDA,2,X))
IF 'X
QUIT
SET Y=$GET(^(X,0))
IF $EXTRACT(Y)="T"!($EXTRACT(Y)="V")
Begin DoDot:1
+5 IF $PIECE(Y,";",2)=""!'$PIECE(Y,";",3)
QUIT
+6 IF Y["T;"
IF $PIECE(Y,U,2)]""
QUIT
+7 SET ^TMP("QMAN SCRIPT",$JOB,$EXTRACT(Y),$PIECE(Y,";",2),+$PIECE(Y,";",3))=X
End DoDot:1
+8 SET (Z,X)=0
+9 FOR
SET X=$ORDER(^TMP("QMAN SCRIPT",$JOB,"T",X))
IF 'X
QUIT
Begin DoDot:1
+10 SET Z=$ORDER(^TMP("QMAN SCRIPT",$JOB,"V",Z))
+11 IF 'Z
QUIT
+12 SET Z=$ORDER(^TMP("QMAN SCRIPT",$JOB,"V",Z,0))
+13 IF '$PIECE($GET(^AMQQ(1,+Z,0)),U,4)
QUIT
SET F=$PIECE(^(0),U,4)
SET Z=$PIECE(^(0),U,3)
+14 IF 'Z!'F
QUIT
+15 SET Z=$GET(^DD(Z,F,0))
+16 IF $PIECE(Z,U,2)'["P"
QUIT
+17 SET Z=$PIECE(Z,U,3)
+18 SET Z=U_$SELECT($EXTRACT(Z,$LENGTH(Z))="(":$PIECE(Z,"("),1:$EXTRACT(Z,1,$LENGTH(Z)-1)_")")
+19 SET Y=0
+20 FOR
SET Y=$ORDER(^TMP("QMAN SCRIPT",$JOB,"T",X,Y))
IF 'Y
QUIT
SET ZZ=^(Y)
Begin DoDot:2
+21 IF '$DATA(@Z@(Y,0))
QUIT
SET %=$PIECE(^(0),U)
+22 SET ^AMQQ(2,AMQQSDA,2,ZZ,0)=^AMQQ(2,AMQQSDA,2,ZZ,0)_U_%
End DoDot:2
End DoDot:1
+23 QUIT
POINTER ;CONVERT SCRIPT REAL VALUES TO POINTER VALUES
+1 NEW X,Y,Z,ZZ
+2 KILL ^TMP("QMAN SCRIPT",$JOB)
+3 SET X=0
+4 FOR
SET X=$ORDER(^AMQQ(2,AMQQSDA,2,X))
IF 'X
QUIT
SET Y=$GET(^(X,0))
IF $EXTRACT(Y)="T"!($EXTRACT(Y)="V")
Begin DoDot:1
+5 IF $PIECE(Y,";",2)=""!($PIECE(Y,";",3)="")
QUIT
+6 SET ^TMP("QMAN SCRIPT",$JOB,$EXTRACT(Y),$PIECE(Y,";",2),$PIECE($PIECE(Y,";",3),U))=X_U_$PIECE(Y,U,2)
End DoDot:1
+7 SET X=0
+8 FOR
SET X=$ORDER(^TMP("QMAN SCRIPT",$JOB,"T",X))
IF 'X
QUIT
Begin DoDot:1
+9 SET Y=0
+10 FOR
SET Y=$ORDER(^TMP("QMAN SCRIPT",$JOB,"T",X,Y))
IF 'Y
QUIT
SET ZZ=^(Y)
Begin DoDot:2
+11 SET Z=X+9
+12 SET Z=$ORDER(^TMP("QMAN SCRIPT",$JOB,"V",Z,0))
+13 IF '$PIECE($GET(^AMQQ(1,+Z,0)),U,4)
QUIT
SET F=$PIECE(^(0),U,4)
SET Z=$PIECE(^(0),U,3)
+14 IF 'Z!'F
QUIT
+15 SET Z=$GET(^DD(Z,F,0))
+16 IF $PIECE(Z,U,2)'["P"
QUIT
+17 SET Z=$PIECE(Z,U,3)
+18 SET Z=U_$SELECT($EXTRACT(Z,$LENGTH(Z))="(":$PIECE(Z,"("),1:$EXTRACT(Z,1,$LENGTH(Z)-1)_")")
+19 SET XREF=$SELECT(Z'["ICD9":"B",1:"AB")
+20 SET Z=$ORDER(@Z@(XREF,$PIECE(ZZ,U,2),0))
+21 IF 'Z
QUIT
+22 SET $PIECE(^AMQQ(2,AMQQSDA,2,+ZZ,0),";",3)=Z
End DoDot:2
End DoDot:1
+23 QUIT
