AMQQEM4.m

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       ;