Routine: AMQQEM41

AMQQEM41 ; IHS/CMI/THL - DOCUMENTATION OF EXPORT INSTRUCTIONS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;-----

RUN N T,I,X,Y,Z,%,I,J

 D VAR,INTRO,LOGIC,FIELD,SET,SAVE

EXIT K AMQQEML

VAR S T="^UTILITY(""AMQQ"",$J,""EMAN"",2,AMQQEML)"

 S AMQQEML=0

INC S AMQQEML=AMQQEML+1

INTRO ;

 S %=$P(@AMQQ200(3)@(DUZ,0),U)

 S %=$P(%,",",2,9)_" "_$P(%,",")

 S %="This report requested by "_%

 D INC

 S @T=%

 D INC

 S Y=DT

 X ^DD("DD")

 S @T="Date created: "_Y

 F %=1,2 D INC S @T=" "

 S %=$G(AMQQEM("MLEN"))

 I % D INC S @T="Record type: DELIMITED"

 S %=$G(AMQQEM("LEN"))

 I % D INC S @T="Maximum record length: "_%

 S %=$G(AMQQEM("DEL"))

 I %'="" D INC S @T="Delimiter: '"_%_"'"

 S %=$G(AMQQEM("FIX"))

 I % D INC S @T="Field length: "_%

 S %=$G(AMQQEM("FILE"))

 I %'="" D INC S @T="Destination path/file: "_%

 F %=1,2 D INC S @T=" "

LOGIC ;

 D INC

 S @T="Search criteria =>"

 D INC

 S @T=" "

 F I=0:0 S I=$O(^UTILITY("AMQQ",$J,"LIST",I)) Q:'I  S X=^(I) D

 .S %="",Z=0 I $P(X,",")["W ?" S Z=+$E($P(X,","),4,99) F J=1:1:Z S %=%_" "

 .F J=1:1 S Y=$P(X,",",J) Q:Y=""  I $E(Y)="""",$E(Y,$L(Y))="""" S Y=$E(Y,2,$L(Y)-1),%=%_Y

 .D INC S @T=%

FIELD ;

 F %=1,2 D INC S @T=" "

 D INC

 S @T="VARIABLES / FIELDS"

 D INC

 S @T=" "

 D INC

 S @T="NAME                DATA TYPE   LENGTH      COLUMN #"

 D INC

 S @T="------------------- ----------- ----------- -----------"

 F I=1:1 S X=$P(AMQQEMFS,U,I) Q:'X  D

 .S X=^UTILITY("AMQQ",$J,"FLAT",X,0)

 .S X(1)=$P(X,U,6)

 .S X(2)=$P(X,U,4)

 .S X(3)=$P(X,U,7)

 .S X(4)=I

 .S X(1)=$E(X(1),1,19)_$J("",20-$L(X(1)))

 .I $G(AMQQEM("FIX")) S X(3)=AMQQEM("FIX")

 .F J=2:1:4 S X(J)=$E(X(J),1,11) I J'=4 S X(J)=X(J)_$J("",12-$L(X(J)))

 .S X=""

 .F J=1:1:4 S X=X_X(J)

 .D INC

 .S @T=X

SET ;

 I $D(AMQQEX("TDFN")) F I=1:1 Q:'$D(^UTILITY("AMQQ",$J,"EMAN",2,I))  S ^AMQQ(3.1,AMQQEX("TDFN"),2,I,0)=^(I),$P(^AMQQ(3.1,AMQQEX("TDFN"),2,0),U,3,4)=I_U_I

 I $D(AMQQEX("DOC")) S AMQQEFN=AMQQEX("DOC") X AMQQEX("WRITE") E  D BUSY^AMQQEM4

 I '$D(AMQQSTOP),$D(AMQQEX("DOC")) X AMQQEX("USE") F I=1:1 Q:'$D(^UTILITY("AMQQ",$J,"EMAN",2,I))  W ^(I),!

 X $G(AMQQEX("CLOSE"))

 K AMQQSTOP

SAVE ; SAVE SEARCH LOGIC AND FORMATTING INSTRUCTIONS

TMP ; THIS OPTION IS TEMPORARILY DISABLED UNTIL DR. GRAU RESTORES THE SCRIPT OPTION ON THE OPENING SCREEN

 W !!

 W !!

 S DIR(0)="Y"

 S DIR("A")="Save the search logic and formatting instructions for future use"

 S DIR("B")="NO"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I "^"[X!('$G(Y)) Q

 I X?2."^" S AMQQQUIT="" Q

 D STORE^AMQQQE

 I $D(AMQQQUIT) Q

 I $D(AMQQCPLF) D ^AMQQCMPS

AMQQEM41  ; IHS/CMI/THL - DOCUMENTATION OF EXPORT INSTRUCTIONS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;-----

RUN        NEW T,I,X,Y,Z,%,I,J

 +1        DO VAR

           DO INTRO

           DO LOGIC

           DO FIELD

           DO SET

           DO SAVE

EXIT       KILL AMQQEML

 +1        QUIT

 +2       ;

VAR        SET T="^UTILITY(""AMQQ"",$J,""EMAN"",2,AMQQEML)"

 +1        SET AMQQEML=0

 +2        QUIT

 +3       ;

INC        SET AMQQEML=AMQQEML+1

 +1        QUIT

 +2       ;

INTRO     ;

 +1        SET %=$PIECE(@AMQQ200(3)@(DUZ,0),U)

 +2        SET %=$PIECE(%,",",2,9)_" "_$PIECE(%,",")

 +3        SET %="This report requested by "_%

 +4        DO INC

 +5        SET @T=%

 +6        DO INC

 +7        SET Y=DT

 +8        XECUTE ^DD("DD")

 +9        SET @T="Date created: "_Y

 +10       FOR %=1,2

               DO INC

               SET @T=" "

 +11       SET %=$GET(AMQQEM("MLEN"))

 +12       IF %

               DO INC

               SET @T="Record type: DELIMITED"

 +13       SET %=$GET(AMQQEM("LEN"))

 +14       IF %

               DO INC

               SET @T="Maximum record length: "_%

 +15       SET %=$GET(AMQQEM("DEL"))

 +16       IF %'=""

               DO INC

               SET @T="Delimiter: '"_%_"'"

 +17       SET %=$GET(AMQQEM("FIX"))

 +18       IF %

               DO INC

               SET @T="Field length: "_%

 +19       SET %=$GET(AMQQEM("FILE"))

 +20       IF %'=""

               DO INC

               SET @T="Destination path/file: "_%

 +21       FOR %=1,2

               DO INC

               SET @T=" "

 +22       QUIT

 +23      ;

LOGIC     ;

 +1        DO INC

 +2        SET @T="Search criteria =>"

 +3        DO INC

 +4        SET @T=" "

 +5        FOR I=0:0

               SET I=$ORDER(^UTILITY("AMQQ",$JOB,"LIST",I))

               IF 'I

                   QUIT

               SET X=^(I)

               Begin DoDot:1

 +6                SET %=""

                   SET Z=0

                   IF $PIECE(X,",")["W ?"

                       SET Z=+$EXTRACT($PIECE(X,","),4,99)

                       FOR J=1:1:Z

                           SET %=%_" "

 +7                FOR J=1:1

                       SET Y=$PIECE(X,",",J)

                       IF Y=""

                           QUIT

                       IF $EXTRACT(Y)=""""

                           IF $EXTRACT(Y,$LENGTH(Y))=""""

                               SET Y=$EXTRACT(Y,2,$LENGTH(Y)-1)

                               SET %=%_Y

 +8                DO INC

                   SET @T=%

               End DoDot:1

 +9        QUIT

 +10      ;

FIELD     ;

 +1        FOR %=1,2

               DO INC

               SET @T=" "

 +2        DO INC

 +3        SET @T="VARIABLES / FIELDS"

 +4        DO INC

 +5        SET @T=" "

 +6        DO INC

 +7        SET @T="NAME                DATA TYPE   LENGTH      COLUMN #"

 +8        DO INC

 +9        SET @T="------------------- ----------- ----------- -----------"

 +10       FOR I=1:1

               SET X=$PIECE(AMQQEMFS,U,I)

               IF 'X

                   QUIT

               Begin DoDot:1

 +11               SET X=^UTILITY("AMQQ",$JOB,"FLAT",X,0)

 +12               SET X(1)=$PIECE(X,U,6)

 +13               SET X(2)=$PIECE(X,U,4)

 +14               SET X(3)=$PIECE(X,U,7)

 +15               SET X(4)=I

 +16               SET X(1)=$EXTRACT(X(1),1,19)_$JUSTIFY("",20-$LENGTH(X(1)))

 +17               IF $GET(AMQQEM("FIX"))

                       SET X(3)=AMQQEM("FIX")

 +18               FOR J=2:1:4

                       SET X(J)=$EXTRACT(X(J),1,11)

                       IF J'=4

                           SET X(J)=X(J)_$JUSTIFY("",12-$LENGTH(X(J)))

 +19               SET X=""

 +20               FOR J=1:1:4

                       SET X=X_X(J)

 +21               DO INC

 +22               SET @T=X

               End DoDot:1

 +23       QUIT

 +24      ;

SET       ;

 +1        IF $DATA(AMQQEX("TDFN"))

               FOR I=1:1

                   IF '$DATA(^UTILITY("AMQQ",$JOB,"EMAN",2,I))

                       QUIT

                   SET ^AMQQ(3.1,AMQQEX("TDFN"),2,I,0)=^(I)

                   SET $PIECE(^AMQQ(3.1,AMQQEX("TDFN"),2,0),U,3,4)=I_U_I

 +2        IF $DATA(AMQQEX("DOC"))

               SET AMQQEFN=AMQQEX("DOC")

               XECUTE AMQQEX("WRITE")

              IF '$TEST

                   DO BUSY^AMQQEM4

 +3        IF '$DATA(AMQQSTOP)

               IF $DATA(AMQQEX("DOC"))

                   XECUTE AMQQEX("USE")

                   FOR I=1:1

                       IF '$DATA(^UTILITY("AMQQ",$JOB,"EMAN",2,I))

                           QUIT

                       WRITE ^(I),!

 +4        XECUTE $GET(AMQQEX("CLOSE"))

 +5        KILL AMQQSTOP

 +6        QUIT

 +7       ;

SAVE      ; SAVE SEARCH LOGIC AND FORMATTING INSTRUCTIONS

TMP       ; THIS OPTION IS TEMPORARILY DISABLED UNTIL DR. GRAU RESTORES THE SCRIPT OPTION ON THE OPENING SCREEN

 +1        WRITE !!

 +2        QUIT

 +3        WRITE !!

 +4        SET DIR(0)="Y"

 +5        SET DIR("A")="Save the search logic and formatting instructions for future use"

 +6        SET DIR("B")="NO"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF "^"[X!('$GET(Y))

               QUIT

 +11       IF X?2."^"

               SET AMQQQUIT=""

               QUIT

 +12       DO STORE^AMQQQE

 +13       IF $DATA(AMQQQUIT)

               QUIT

 +14       IF $DATA(AMQQCPLF)

               DO ^AMQQCMPS

 +15       QUIT

 +16      ;

AMQQEM41.m