AMQQEM4 ; IHS/CMI/THL - RECOMPILE DATA EXOPRT INSTRUCTIONS AND EXPORT DATA ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN D VAR
D RC
D ENTRY
Q:$D(AMQQQUIT)
D ^AMQQEM41
D BACK
EXIT K ^UTILITY("AMQQ",$J,"FLAT"),T,AMQQEML,AMQQEMX,AMQQEMI,AMQQEX
Q
;
INC S AMQQEML=AMQQEML+1
Q
;
VAR S T="^UTILITY(""AMQQ"",$J,""EMAN"",1,AMQQEML)"
S AMQQEML=1
S @T="S AMQQEMX="""""
S AMQQEX("HEADER")=""
I '$D(AMQQEM("FIX")),AMQQEM("DEL")="TAB" S AMQQEM("DEL")=$C(9)
I $G(AMQQEM("DEL"))="UP ARROW" S AMQQEM("DEL")=U
Q
;
RC N A F AMQQEMI=1:1 S AMQQEMN=$P(AMQQEMFS,U,AMQQEMI) Q:'AMQQEMN D
.S %=$G(AMQQEX("HEADER"))
.S:%'="" %=%_$G(AMQQEM("DEL"))
.S A=$P(@G@(AMQQEMN,0),U,6)
.I $D(AMQQEM("FIX")),'$D(AMQQEX("NO HEADER")) S A=$E(A,1,AMQQEM("HLEN"))_$J("",AMQQEM("FIX")-$L(A))
.S AMQQEX("HEADER")=%_A
.D INC
.S @T=@G@(AMQQEMN,1)
.F %=2,3 I $G(@G@(AMQQEMN,%))'="" D INC S @T=^(%)
.S %=$G(AMQQEM("FIX"))
.I % D INC S @T="S X=$E(X,1,"_%_") I $L(X)<"_%_" N % S %="""",$P(%,"" "",1+"_%_"-$L(X))="""",X=X_%" D INC S @T="S AMQQEMX=AMQQEMX_X" Q
.S %=+$P($G(^UTILITY("AMQQ",$J,"FLAT",AMQQEMN,0)),U,7)
.I % D INC S @T="S X=$E(X,1,"_%_")" D INC S @T="S AMQQEMX=AMQQEMX_X_"""_AMQQEM("DEL")_"""" Q
Q
;
BACK D EXIT^AMQQEMAN ; CLEANUP
S DIR(0)="Y"
S DIR("A")="Want to run this request as a 'background' job"
S DIR("B")="NO"
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
I X?1."^" S AMQQQUIT="" K DIRUT,DIROUT,DUOUT,DTOUT Q
I Y D ETASK Q
I ^DD("OS")=18 D ERUN18 Q
U IO D ERUN D ^%ZISC
Q
;
EXPORT ; ENTRY POINT FROM SEARCH CODE
I AMQQTOT=1,'$D(ZTQUEUED),'$D(AMQQEX("NO HEADER")) U 0 W:$G(IOST)["C-" AMQQEX("HEADER"),!
I AMQQTOT=1,$D(AMQQEX("USE")),'$D(AMQQEX("NO HEADER")) X AMQQEX("USE") W AMQQEX("HEADER"),!
F I=0:0 S I=$O(^UTILITY("AMQQ",$J,"EMAN",1,I)) Q:'I X ^UTILITY("AMQQ",$J,"EMAN",1,I)
I $G(AMQQEMX)="" Q
S AMQQEMX=$E(AMQQEMX,1,$L(AMQQEMX)-1)
I '$D(ZTQUEUED) U 0 I $G(IOST)["C-" W AMQQEMX,!
I $D(AMQQEX("USE")) X AMQQEX("USE") W AMQQEMX,!
I $D(AMQQEX("TDFN")) S ^AMQQ(3.1,AMQQEX("TDFN"),1,AMQQTOT,0)=AMQQEMX,$P(^AMQQ(3.1,AMQQEX("TDFN"),1,0),U,3,4)=(AMQQTOT_U_AMQQTOT) Q
Q
;
ENTRY ; AMQQ(3.1 ENTRY
I '$D(AMQQEX("TDFN")) Q
S DIE="^AMQQ(3.1,"
S DR=.02_"///"_+$G(DUZ)_";.03///"_DT
S DA=AMQQEX("TDFN")
D ^DIE
K DIC,DIE,DA,DR
F %=1,2 S ^AMQQ(3.1,AMQQEX("TDFN"),%,0)="^^^^"_DT_U
Q
;
NAME ; - EP - MUMPS FILE NAME ; ENTRY POINT FROM AMQQEMAN
D MARK^AMQQEMAN
W "MUMPS FILE NAME",!
N1 S DIC="^AMQQ(3.1,"
S DIC(0)="AEQMZL"
S DIC("A")="File name: "
D ^DIC
K DIC
I X=U S AMQQFNMP="",AMQQQUIT="" Q
I X="^^"!($D(DTOUT)) K DTOUT S AMQQQUIT="" Q
I X=""!($D(DUOUT)) W " ?? Enter '^^' to terminate the session." K DUOUT G NAME
I '$P(Y,U,3) D OVER I $D(AMQQQUIT) Q
I Y="" W ! G N1
S AMQQEX("TDFN")=+Y
S AMQQERUN=99
Q
;
OVER N AMQQEMNM
S AMQQEMNM=$P(Y,U,2)
S DA=+Y
S %=$P(^AMQQ(3.1,DA,0),U,2)
I $G(DUZ)'=%,% W !!,*7,"Someone else has already saved an ASCI file under this name.",!,"Try another name please..." S Y="" Q
W !!,*7,"You already have an ASCI file stored under this name!"
S DIR(0)="Y"
S DIR("A")="Want to erase the old file and replace it"
S DIR("B")="NO"
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
I "^"[X S Y="" Q
I X?2."^" S AMQQQUIT="" Q
I 'Y S Y="" Q
S DIK="^AMQQ(3.1,"
D ^DIK
S X=AMQQEMNM
S DINUM=DA
S DIC=DIK
S DIC(0)="L"
K DD,DO
D FILE^DICN
K DIC,DIK,DA
Q
;
ETASK S ZTRTN="ERUN^AMQQEM4",ZTIO=""
S ZTDESC="QUERY UTILITY DATA EXPORT MANAGER"
F I=1:1 S %=$P("AMQQRM*;AMQQEX(;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I) Q:%="" S ZTSAVE(%)=""
D ^%ZTLOAD
D ^%ZISC
W !!,$S($D(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
H 3
W @IOF
Q
;
ERUN ; EXPORT DATA
I $D(AMQQEX("FILE")) S AMQQEFN=AMQQEX("FILE")
I $G(IOST)["C-" W @IOF
S AMQQRMFL="EXPORT^AMQQEM4"
I $D(AMQQEX("WRITE")) X AMQQEX("WRITE") E D BUSY
I '$D(AMQQSTOP) S:'$D(AMQQNOET) X="ERR^AMQQEM4",@^%ZOSF("TRAP") X $G(AMQQEX("WRITE")),AMQV(0)
X $G(AMQQEX("CLOSE"))
I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
K AMQQEFN,AMQQSTOP
Q
;
ERUN18 ; EXPORT DATA
I $D(AMQQEX("FILE")) S AMQQEFN=AMQQEX("FILE")
I $G(IOST)["C-" W @IOF
S AMQQRMFL="EXPORT^AMQQEM4"
I '$D(AMQQSTOP) S:'$D(AMQQNOET) X="ERR^AMQQEM4",@^%ZOSF("TRAP") X $G(AMQQEX("WRITE")),AMQV(0)
X $G(AMQQEX("CLOSE"))
I $D(ZTQUEUED) D EXIT2^AMQQKILL S ZTREQ="@"
K AMQQEFN,AMQQSTOP
Q
;
BUSY ; EP FROM AMQQEM41 ; HFS IS BUSY
I $G(IOST)["C-" D
.W !,"The Host File Server is being used by someone else."
.W !,"If it is not free in 60 seconds, I must terminate this session"
.W !!
N H,T,D
S H=$H
S D=+H
S T=$P(H,",",2)+60
F X AMQQEX("WRITE") Q:$T I +$H'=D!($P($H,",",2)>T) S AMQQSTOP="" Q
Q
;
ERR ; ERROR MGMT
X AMQQEX("CLOSE")
D ^%ZISC
D EXIT
I $G(IOST)["C-" W *7,"WHOOPS...AN ERROR HAS OCCURRED DURING THE SEARCH. SESSION TERMINATED.",!! H 3
Q
;
AMQQEM4 ; IHS/CMI/THL - RECOMPILE DATA EXOPRT INSTRUCTIONS AND EXPORT DATA ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN DO VAR
+1 DO RC
+2 DO ENTRY
+3 IF $DATA(AMQQQUIT)
QUIT
+4 DO ^AMQQEM41
+5 DO BACK
EXIT KILL ^UTILITY("AMQQ",$JOB,"FLAT"),T,AMQQEML,AMQQEMX,AMQQEMI,AMQQEX
+1 QUIT
+2 ;
INC SET AMQQEML=AMQQEML+1
+1 QUIT
+2 ;
VAR SET T="^UTILITY(""AMQQ"",$J,""EMAN"",1,AMQQEML)"
+1 SET AMQQEML=1
+2 SET @T="S AMQQEMX="""""
+3 SET AMQQEX("HEADER")=""
+4 IF '$DATA(AMQQEM("FIX"))
IF AMQQEM("DEL")="TAB"
SET AMQQEM("DEL")=$CHAR(9)
+5 IF $GET(AMQQEM("DEL"))="UP ARROW"
SET AMQQEM("DEL")=U
+6 QUIT
+7 ;
RC NEW A
FOR AMQQEMI=1:1
SET AMQQEMN=$PIECE(AMQQEMFS,U,AMQQEMI)
IF 'AMQQEMN
QUIT
Begin DoDot:1
+1 SET %=$GET(AMQQEX("HEADER"))
+2 IF %'=""
SET %=%_$GET(AMQQEM("DEL"))
+3 SET A=$PIECE(@G@(AMQQEMN,0),U,6)
+4 IF $DATA(AMQQEM("FIX"))
IF '$DATA(AMQQEX("NO HEADER"))
SET A=$EXTRACT(A,1,AMQQEM("HLEN"))_$JUSTIFY("",AMQQEM("FIX")-$LENGTH(A))
+5 SET AMQQEX("HEADER")=%_A
+6 DO INC
+7 SET @T=@G@(AMQQEMN,1)
+8 FOR %=2,3
IF $GET(@G@(AMQQEMN,%))'=""
DO INC
SET @T=^(%)
+9 SET %=$GET(AMQQEM("FIX"))
+10 IF %
DO INC
SET @T="S X=$E(X,1,"_%_") I $L(X)<"_%_" N % S %="""",$P(%,"" "",1+"_%_"-$L(X))="""",X=X_%"
DO INC
SET @T="S AMQQEMX=AMQQEMX_X"
QUIT
+11 SET %=+$PIECE($GET(^UTILITY("AMQQ",$JOB,"FLAT",AMQQEMN,0)),U,7)
+12 IF %
DO INC
SET @T="S X=$E(X,1,"_%_")"
DO INC
SET @T="S AMQQEMX=AMQQEMX_X_"""_AMQQEM("DEL")_""""
QUIT
End DoDot:1
+13 QUIT
+14 ;
BACK ; CLEANUP
DO EXIT^AMQQEMAN
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Want to run this request as a 'background' job"
+3 SET DIR("B")="NO"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DUOUT)
SET DIRUT=1
+7 IF X?1."^"
SET AMQQQUIT=""
KILL DIRUT,DIROUT,DUOUT,DTOUT
QUIT
+8 IF Y
DO ETASK
QUIT
+9 IF ^DD("OS")=18
DO ERUN18
QUIT
+10 USE IO
DO ERUN
DO ^%ZISC
+11 QUIT
+12 ;
EXPORT ; ENTRY POINT FROM SEARCH CODE
+1 IF AMQQTOT=1
IF '$DATA(ZTQUEUED)
IF '$DATA(AMQQEX("NO HEADER"))
USE 0
IF $GET(IOST)["C-"
WRITE AMQQEX("HEADER"),!
+2 IF AMQQTOT=1
IF $DATA(AMQQEX("USE"))
IF '$DATA(AMQQEX("NO HEADER"))
XECUTE AMQQEX("USE")
WRITE AMQQEX("HEADER"),!
+3 FOR I=0:0
SET I=$ORDER(^UTILITY("AMQQ",$JOB,"EMAN",1,I))
IF 'I
QUIT
XECUTE ^UTILITY("AMQQ",$JOB,"EMAN",1,I)
+4 IF $GET(AMQQEMX)=""
QUIT
+5 SET AMQQEMX=$EXTRACT(AMQQEMX,1,$LENGTH(AMQQEMX)-1)
+6 IF '$DATA(ZTQUEUED)
USE 0
IF $GET(IOST)["C-"
WRITE AMQQEMX,!
+7 IF $DATA(AMQQEX("USE"))
XECUTE AMQQEX("USE")
WRITE AMQQEMX,!
+8 IF $DATA(AMQQEX("TDFN"))
SET ^AMQQ(3.1,AMQQEX("TDFN"),1,AMQQTOT,0)=AMQQEMX
SET $PIECE(^AMQQ(3.1,AMQQEX("TDFN"),1,0),U,3,4)=(AMQQTOT_U_AMQQTOT)
QUIT
+9 QUIT
+10 ;
ENTRY ; AMQQ(3.1 ENTRY
+1 IF '$DATA(AMQQEX("TDFN"))
QUIT
+2 SET DIE="^AMQQ(3.1,"
+3 SET DR=.02_"///"_+$GET(DUZ)_";.03///"_DT
+4 SET DA=AMQQEX("TDFN")
+5 DO ^DIE
+6 KILL DIC,DIE,DA,DR
+7 FOR %=1,2
SET ^AMQQ(3.1,AMQQEX("TDFN"),%,0)="^^^^"_DT_U
+8 QUIT
+9 ;
NAME ; - EP - MUMPS FILE NAME ; ENTRY POINT FROM AMQQEMAN
+1 DO MARK^AMQQEMAN
+2 WRITE "MUMPS FILE NAME",!
N1 SET DIC="^AMQQ(3.1,"
+1 SET DIC(0)="AEQMZL"
+2 SET DIC("A")="File name: "
+3 DO ^DIC
+4 KILL DIC
+5 IF X=U
SET AMQQFNMP=""
SET AMQQQUIT=""
QUIT
+6 IF X="^^"!($DATA(DTOUT))
KILL DTOUT
SET AMQQQUIT=""
QUIT
+7 IF X=""!($DATA(DUOUT))
WRITE " ?? Enter '^^' to terminate the session."
KILL DUOUT
GOTO NAME
+8 IF '$PIECE(Y,U,3)
DO OVER
IF $DATA(AMQQQUIT)
QUIT
+9 IF Y=""
WRITE !
GOTO N1
+10 SET AMQQEX("TDFN")=+Y
+11 SET AMQQERUN=99
+12 QUIT
+13 ;
OVER NEW AMQQEMNM
+1 SET AMQQEMNM=$PIECE(Y,U,2)
+2 SET DA=+Y
+3 SET %=$PIECE(^AMQQ(3.1,DA,0),U,2)
+4 IF $GET(DUZ)'=%
IF %
WRITE !!,*7,"Someone else has already saved an ASCI file under this name.",!,"Try another name please..."
SET Y=""
QUIT
+5 WRITE !!,*7,"You already have an ASCI file stored under this name!"
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Want to erase the old file and replace it"
+8 SET DIR("B")="NO"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DUOUT)
SET DIRUT=1
+12 IF "^"[X
SET Y=""
QUIT
+13 IF X?2."^"
SET AMQQQUIT=""
QUIT
+14 IF 'Y
SET Y=""
QUIT
+15 SET DIK="^AMQQ(3.1,"
+16 DO ^DIK
+17 SET X=AMQQEMNM
+18 SET DINUM=DA
+19 SET DIC=DIK
+20 SET DIC(0)="L"
+21 KILL DD,DO
+22 DO FILE^DICN
+23 KILL DIC,DIK,DA
+24 QUIT
+25 ;
ETASK SET ZTRTN="ERUN^AMQQEM4"
SET ZTIO=""
+1 SET ZTDESC="QUERY UTILITY DATA EXPORT MANAGER"
+2 FOR I=1:1
SET %=$PIECE("AMQQRM*;AMQQEX(;AMQV(;AMQQ200(;AMQQRV;AMQQNV;AMQQXV;^UTILITY(""AMQQ"",$J,;^UTILITY(""AMQQ RAND"",$J,;^UTILITY(""AMQQ TAX"",$J,",";",I)
IF %=""
QUIT
SET ZTSAVE(%)=""
+3 DO ^%ZTLOAD
+4 DO ^%ZISC
+5 WRITE !!,$SELECT($DATA(ZTSK):"Request queued!",1:"Request cancelled!"),!!!
+6 HANG 3
+7 WRITE @IOF
+8 QUIT
+9 ;
ERUN ; EXPORT DATA
+1 IF $DATA(AMQQEX("FILE"))
SET AMQQEFN=AMQQEX("FILE")
+2 IF $GET(IOST)["C-"
WRITE @IOF
+3 SET AMQQRMFL="EXPORT^AMQQEM4"
+4 IF $DATA(AMQQEX("WRITE"))
XECUTE AMQQEX("WRITE")
IF '$TEST
DO BUSY
+5 IF '$DATA(AMQQSTOP)
IF '$DATA(AMQQNOET)
SET X="ERR^AMQQEM4"
SET @^%ZOSF("TRAP")
XECUTE $GET(AMQQEX("WRITE"))
XECUTE AMQV(0)
+6 XECUTE $GET(AMQQEX("CLOSE"))
+7 IF $DATA(ZTQUEUED)
DO EXIT2^AMQQKILL
SET ZTREQ="@"
+8 KILL AMQQEFN,AMQQSTOP
+9 QUIT
+10 ;
ERUN18 ; EXPORT DATA
+1 IF $DATA(AMQQEX("FILE"))
SET AMQQEFN=AMQQEX("FILE")
+2 IF $GET(IOST)["C-"
WRITE @IOF
+3 SET AMQQRMFL="EXPORT^AMQQEM4"
+4 IF '$DATA(AMQQSTOP)
IF '$DATA(AMQQNOET)
SET X="ERR^AMQQEM4"
SET @^%ZOSF("TRAP")
XECUTE $GET(AMQQEX("WRITE"))
XECUTE AMQV(0)
+5 XECUTE $GET(AMQQEX("CLOSE"))
+6 IF $DATA(ZTQUEUED)
DO EXIT2^AMQQKILL
SET ZTREQ="@"
+7 KILL AMQQEFN,AMQQSTOP
+8 QUIT
+9 ;
BUSY ; EP FROM AMQQEM41 ; HFS IS BUSY
+1 IF $GET(IOST)["C-"
Begin DoDot:1
+2 WRITE !,"The Host File Server is being used by someone else."
+3 WRITE !,"If it is not free in 60 seconds, I must terminate this session"
+4 WRITE !!
End DoDot:1
+5 NEW H,T,D
+6 SET H=$HOROLOG
+7 SET D=+H
+8 SET T=$PIECE(H,",",2)+60
+9 FOR
XECUTE AMQQEX("WRITE")
IF $TEST
QUIT
IF +$HOROLOG'=D!($PIECE($HOROLOG,",",2)>T)
SET AMQQSTOP=""
QUIT
+10 QUIT
+11 ;
ERR ; ERROR MGMT
+1 XECUTE AMQQEX("CLOSE")
+2 DO ^%ZISC
+3 DO EXIT
+4 IF $GET(IOST)["C-"
WRITE *7,"WHOOPS...AN ERROR HAS OCCURRED DURING THE SEARCH. SESSION TERMINATED.",!!
HANG 3
+5 QUIT
+6 ;
