AMQQEM11.m

AMQQEM11 ; IHS/CMI/THL - OVERFLOW FROM AMQQEMAN ;

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

 ;-----

MARK W !!,"---------",!!

 Q

 ;

FWD S AMQQEMS=AMQQERUN_U_AMQQEMS

 Q

 ;

BACKUP S AMQQERUN=$P(AMQQEMS,U)-1

 S AMQQEMS=$P(AMQQEMS,U,2,99)

 Q

 ;

CK I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT))!(X="") K DIRUT,DUOUT,DTOUT,DIROUT S AMQQQUIT=""

 Q

 ;

DATA ; EP FROM AMQQEMAN

 D MARK

 W "ASSIGN DATA TYPE TO EACH FIELD",!

 I $D(AMQQEM("DATA")) S DIR("B")=AMQQEM("DATA")

 E  S DIR("B")="DATA TYPE NOT REQUIRED"

 S DIR("?")="Many types of analytic/graphic software require you to assign a 'data type' (e.g., number, date, free text etc.) to ea. field in the file"

 S DIR(0)="S^0:DATA TYPE NOT REQUIRED;1:E-MAN WILL ASSIGN DATA TYPES AUTOMATICALLY;2:E-MAN WILL PROMPT YOU TO ASSIGN A DATA TYPE TO EA. FIELD"

 S DIR("A")="     Your choice"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 D FWD

 S AMQQEM("DATA")=Y

 D SAVE

 I $D(AMQQEMNO) K AMQQEMNO G DATA

 Q

 ;

MLEN ; - EP - DEL FIELD LENGTH ; 7 ; ENTRY POINT FROM AMQQEMAN

 D MARK

 W "MAXIMUM FIELD LENGTH",!

 I $D(AMQQEM("MLEN")) S DIR("B")=AMQQEM("MLEN")

 S DIR(0)="N^1:"_(AMQQEM("LEN")-1)_":"

 S DIR("A")="Max. delimited field length"

 S DIR("?")="The typical maximum length for a delimited field is 16-24 characters.  Check the user's guide for the analytic/graphic software"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 I Y<1 W "  ??",*7 G MLEN

 D FWD

 S AMQQEM("MLEN")=Y

 S AMQQERUN=8

 Q

 ;

FIX ; - EP -

 D MARK

 W "INDIVIDUAL FIELD LENGTH",!

 I $D(AMQQEM("FIX")) S DIR("B")=AMQQEM("FIX")

 S DIR(0)="N^1:"_AMQQEM("LEN")_":"

 S DIR("A")="Field length (no. characters)"

 S DIR("?")="Enter the number of characters in the fixed length field.  See your analytic/graphic software user's guide"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK I $D(AMQQQUIT) Q

 I Y<1 W "  ??",*7 G FIX

 D FWD S AMQQEM("FIX")=Y

 Q

 ;

HLEN ; - EP - DEL FIELD LENGTH ; 9 ; ENTRY POINT FROM AMQQEMAN

 D MARK

 W "MAXIMUM LENGTH OF FIELD HEADER/VARIABLE NAME",!

 I $D(AMQQEX("NO HEADER")) K AMQQEX("NO HEADER") S AMQQEM("HLEN")=0

 I $D(AMQQEM("HLEN")) S DIR("B")=AMQQEM("HLEN")

 I '$D(DIR("B")) S DIR("B")=$G(AMQQEM("MLEN"))+$G(AMQQEM("FIX"))

 S AMQQEM("HLEN")=$G(AMQQEM("MLEN"))+$G(AMQQEM("FIX"))

 S DIR(0)="N^0:"_AMQQEM("HLEN")_":"

 S DIR("A")="Max. header/name length"

 S DIR("?")="The typical maximum length for a header/name is 8 characters.  Check the user's guide of your analytic/graphic software"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U D BACKUP Q

 D CK

 I $D(AMQQQUIT) Q

 I Y<0 W "  ??",*7 G MLEN

 I 'Y S AMQQEX("NO HEADER")="" D FWD Q

 D FWD

 S AMQQEM("HLEN")=Y Q

 Q

 ;

SAVE ; SAVE CUSTOM CONFIG

 D MARK

 W "SAVE CUSTOM CONFIGURATION"

 W !! S DIR(0)="Y"

 S DIR("A")="Want to save this custom configuration for future use"

 S DIR("B")="NO"

 D ^DIR

 K DIR

 S:$D(DUOUT) DIRUT=1

 I X=U S AMQQEMNO="" Q

 D CK

 I $D(AMQQQUIT) Q

 I 'Y Q

S1 S DIC="^AMQQ(3,"

 S DIC(0)="AEMQL"

 S DIC("A")="Enter Configuration name: "

 D ^DIC

 K DIC

 I U[X S AMQQEMNO="" Q

 D CK

 I $D(AMQQQUIT) Q

 I Y=-1 Q

 I '$P(Y,U,3) W !!,*7,"A configuration with this name already exists." D  Q:$D(AMQQQUIT)  I Y=0 G S1

 .I DUZ,$P(^AMQQ(3,+Y,0),U,9)'=DUZ W "  Select another name..." S Y=0 Q

 .S DIR(0)="Y"

 .S DIR("A")="Want to replace it with another of the same name"

 .S DIR("B")="NO"

 .S DIR("?")="If you replace the configutation the old configuraton will cease to exist.  If you want to keep the old configuration, enter'NO' and use a new name."

 .D ^DIR

 .K DIR

 .D CK

 .I $D(AMQQQUIT) Q

 S %="^LEN^TYPE^DEL^MLEN^HLEN^FIX^DATA"

 F I=2:1:8 S X=$P(%,U,I),$P(^AMQQ(3,+Y,0),U,I)=$G(AMQQEM(X))

 Q

 ;

AMQQEM11  ; IHS/CMI/THL - OVERFLOW FROM AMQQEMAN ;

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

 +2       ;-----

MARK       WRITE !!,"---------",!!

 +1        QUIT 

 +2       ;

FWD        SET AMQQEMS=AMQQERUN_U_AMQQEMS

 +1        QUIT 

 +2       ;

BACKUP     SET AMQQERUN=$PIECE(AMQQEMS,U)-1

 +1        SET AMQQEMS=$PIECE(AMQQEMS,U,2,99)

 +2        QUIT 

 +3       ;

CK         IF $DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIRUT)!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DUOUT))!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DTOUT))!($DATA">DATA">DATA">DATA">DATA">DATA">DATA">DATA(DIROUT))!(X="")

               KILL DIRUT,DUOUT,DTOUT,DIROUT

               SET AMQQQUIT=""

 +1        QUIT 

 +2       ;

DATA      ; EP FROM AMQQEMAN

 +1        DO MARK

 +2        WRITE "ASSIGN DATA TYPE TO EACH FIELD",!

 +3        IF $DATA(AMQQEM("DATA"))

               SET DIR("B")=AMQQEM("DATA")

 +4       IF '$TEST

               SET DIR("B")="DATA TYPE NOT REQUIRED"

 +5        SET DIR("?")="Many types of analytic/graphic software require you to assign a 'data type' (e.g., number, date, free text etc.) to ea. field in the file"

 +6        SET DIR(0)="S^0:DATA TYPE NOT REQUIRED;1:E-MAN WILL ASSIGN DATA TYPES AUTOMATICALLY;2:E-MAN WILL PROMPT YOU TO ASSIGN A DATA TYPE TO EA. FIELD"

 +7        SET DIR("A")="     Your choice"

 +8        DO ^DIR

 +9        KILL DIR

 +10       IF $DATA(DUOUT)

               SET DIRUT=1

 +11       IF X=U

               DO BACKUP

               QUIT 

 +12       DO CK

 +13       IF $DATA(AMQQQUIT)

               QUIT 

 +14       DO FWD

 +15       SET AMQQEM("DATA")=Y

 +16       DO SAVE

 +17       IF $DATA(AMQQEMNO)

               KILL AMQQEMNO

               GOTO DATA

 +18       QUIT 

 +19      ;

MLEN      ; - EP - DEL FIELD LENGTH ; 7 ; ENTRY POINT FROM AMQQEMAN

 +1        DO MARK

 +2        WRITE "MAXIMUM FIELD LENGTH",!

 +3        IF $DATA(AMQQEM("MLEN"))

               SET DIR("B")=AMQQEM("MLEN")

 +4        SET DIR(0)="N^1:"_(AMQQEM("LEN")-1)_":"

 +5        SET DIR("A")="Max. delimited field length"

 +6        SET DIR("?")="The typical maximum length for a delimited field is 16-24 characters.  Check the user's guide for the analytic/graphic software"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF X=U

               DO BACKUP

               QUIT 

 +11       DO CK

 +12       IF $DATA(AMQQQUIT)

               QUIT 

 +13       IF Y<1

               WRITE "  ??",*7

               GOTO MLEN

 +14       DO FWD

 +15       SET AMQQEM("MLEN")=Y

 +16       SET AMQQERUN=8

 +17       QUIT 

 +18      ;

FIX       ; - EP -

 +1        DO MARK

 +2        WRITE "INDIVIDUAL FIELD LENGTH",!

 +3        IF $DATA(AMQQEM("FIX"))

               SET DIR("B")=AMQQEM("FIX")

 +4        SET DIR(0)="N^1:"_AMQQEM("LEN")_":"

 +5        SET DIR("A")="Field length (no. characters)"

 +6        SET DIR("?")="Enter the number of characters in the fixed length field.  See your analytic/graphic software user's guide"

 +7        DO ^DIR

 +8        KILL DIR

 +9        IF $DATA(DUOUT)

               SET DIRUT=1

 +10       IF X=U

               DO BACKUP

               QUIT 

 +11       DO CK

           IF $DATA(AMQQQUIT)

               QUIT 

 +12       IF Y<1

               WRITE "  ??",*7

               GOTO FIX

 +13       DO FWD

           SET AMQQEM("FIX")=Y

 +14       QUIT 

 +15      ;

HLEN      ; - EP - DEL FIELD LENGTH ; 9 ; ENTRY POINT FROM AMQQEMAN

 +1        DO MARK

 +2        WRITE "MAXIMUM LENGTH OF FIELD HEADER/VARIABLE NAME",!

 +3        IF $DATA(AMQQEX("NO HEADER"))

               KILL AMQQEX("NO HEADER")

               SET AMQQEM("HLEN")=0

 +4        IF $DATA(AMQQEM("HLEN"))

               SET DIR("B")=AMQQEM("HLEN")

 +5        IF '$DATA(DIR("B"))

               SET DIR("B")=$GET(AMQQEM("MLEN"))+$GET(AMQQEM("FIX"))

 +6        SET AMQQEM("HLEN")=$GET(AMQQEM("MLEN"))+$GET(AMQQEM("FIX"))

 +7        SET DIR(0)="N^0:"_AMQQEM("HLEN")_":"

 +8        SET DIR("A")="Max. header/name length"

 +9        SET DIR("?")="The typical maximum length for a header/name is 8 characters.  Check the user's guide of your analytic/graphic software"

 +10       DO ^DIR

 +11       KILL DIR

 +12       IF $DATA(DUOUT)

               SET DIRUT=1

 +13       IF X=U

               DO BACKUP

               QUIT 

 +14       DO CK

 +15       IF $DATA(AMQQQUIT)

               QUIT 

 +16       IF Y<0

               WRITE "  ??",*7

               GOTO MLEN

 +17       IF 'Y

               SET AMQQEX("NO HEADER")=""

               DO FWD

               QUIT 

 +18       DO FWD

 +19       SET AMQQEM("HLEN")=Y

           QUIT 

 +20       QUIT 

 +21      ;

SAVE      ; SAVE CUSTOM CONFIG

 +1        DO MARK

 +2        WRITE "SAVE CUSTOM CONFIGURATION"

 +3        WRITE !!

           SET DIR(0)="Y"

 +4        SET DIR("A")="Want to save this custom configuration for future use"

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

 +6        DO ^DIR

 +7        KILL DIR

 +8        IF $DATA(DUOUT)

               SET DIRUT=1

 +9        IF X=U

               SET AMQQEMNO=""

               QUIT 

 +10       DO CK

 +11       IF $DATA(AMQQQUIT)

               QUIT 

 +12       IF 'Y

               QUIT 

S1         SET DIC="^AMQQ(3,"

 +1        SET DIC(0)="AEMQL"

 +2        SET DIC("A")="Enter Configuration name: "

 +3        DO ^DIC

 +4        KILL DIC

 +5        IF U[X

               SET AMQQEMNO=""

               QUIT 

 +6        DO CK

 +7        IF $DATA(AMQQQUIT)

               QUIT 

 +8        IF Y=-1

               QUIT 

 +9        IF '$PIECE(Y,U,3)

               WRITE !!,*7,"A configuration with this name already exists."

               Begin DoDot:1

 +10               IF DUZ

                       IF $PIECE(^AMQQ(3,+Y,0),U,9)'=DUZ

                           WRITE "  Select another name..."

                           SET Y=0

                           QUIT 

 +11               SET DIR(0)="Y"

 +12               SET DIR("A")="Want to replace it with another of the same name"

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

 +14               SET DIR("?")="If you replace the configutation the old configuraton will cease to exist.  If you want to keep the old configuration, enter'NO' and use a new name."

 +15               DO ^DIR

 +16               KILL DIR

 +17               DO CK

 +18               IF $DATA(AMQQQUIT)

                       QUIT 

               End DoDot:1

               IF $DATA(AMQQQUIT)

                   QUIT 

               IF Y=0

                   GOTO S1

 +19       SET %="^LEN^TYPE^DEL^MLEN^HLEN^FIX^DATA"

 +20       FOR I=2:1:8

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

               SET $PIECE(^AMQQ(3,+Y,0),U,I)=$GET(AMQQEM(X))

 +21       QUIT 

 +22      ;