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
Q
;
VAR S T="^UTILITY(""AMQQ"",$J,""EMAN"",2,AMQQEML)"
S AMQQEML=0
Q
;
INC S AMQQEML=AMQQEML+1
Q
;
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=" "
Q
;
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=%
Q
;
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
Q
;
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
Q
;
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 !!
Q
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
Q
;
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 ;
