AMQQEMAN ; IHS/CMI/THL - Q-MAN TO DOS EXPORT UTILITY. BUILDS FLAT ASCII FILES ACCORDING TO SPECS. ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
RUN S U="^"
F AMQQERUN=1:1:11 D @$P("EXIT^INIT^STUFF^LEN^TYPE^DEL^MLEN^FIX^HLEN^DATA^PATH",U,AMQQERUN) I $D(AMQQQUIT) Q
I '$D(AMQQQUIT) D ^AMQQEM2 ; FORMAT
I '$D(AMQQQUIT) D ^AMQQEM4
K AMQQERUN,AMQQQUIT
EXIT ; - EP -
K AMQQEMS,DIRUT,DUOUT,DTOUT,DIROUT,AMQQEM,%ZA,%ZB,AMQQEM,AMQQEMFS,AMQQEMP,AMQQEMS,AMQQEMZ,AMQQEMN,G,C,P,X,Y,Z,H,I,J,A,N,T,W,AMQQEFN,AMQQEMI,AMQQEMX
Q
;
INIT I '$D(DUZ(2)) W !!,"Kernel variables not present...Session cancelled",*7,!! S AMQQQUIT="" Q
I '$D(IOSL) D HOME^%ZIS
S %=$G(AMQQCCLS)
I %'="P",%'="V" W !!,"The subject of your search must be a PATIENT or a VISIT to create an ASCI file.",!,*7,"Sorry...",!!! H 3 S AMQQQUIT="" Q
S AMQQEMS=""
W !!!,"You are about to create a flat, ASCII file in the MUMPS environment."
W !,"This file will be imported by your analytic/graphic software (e.g., dBase)."
W !!,"Before you create the file, please answer the following questions =>",!
Q
;
STUFF ; 3
D MARK
W "EXPORT TO WHAT APPLICATION",!
S DIR(0)="P^9009073:EQM"
S DIR("A")="Select export format"
S DIR("B")="CUSTOM CONFIG"
S DIR("??")="AMQQEMANCONFIG"
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
I X="" K AMQQEM("STUFF") Q
I X?1."^" S AMQQQUIT="" K DIRUT,DUOUT,DIROUT,DTOUT Q
I Y["CUSTOM CONFIG" K AMQQEM("STUFF") D FWD Q
S AMQQEM("STUFF")=^AMQQ(3,+Y,0)
D FWD
I $G(^AMQQ(3,+Y,2))]"" S AMQQEM("DATE FORMAT")=^(2)
Q
;
CK ; EP FROM MANY ROUTINES
I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT))!(X="^^") K DIRUT,DUOUT,DTOUT,DIROUT S AMQQQUIT=""
Q
;
MARK ; - EP -
W !!,"---------",!!
Q
;
FWD S AMQQEMS=AMQQERUN_U_AMQQEMS
Q
;
BACKUP S AMQQERUN=$P(AMQQEMS,U)-1
S AMQQEMS=$P(AMQQEMS,U,2,99)
Q
;
LEN ; RECORD LENGTH ; 4
S %=$P($G(AMQQEM("STUFF")),U,2)
I % S AMQQEM("LEN")=% Q
D MARK
W "MAXIMUM RECORD LENGTH",!
S DIR("B")=$S($D(AMQQEM("LEN")):AMQQEM("LEN"),1:256)
S DIR(0)="N^1:256:0"
S DIR("A")="Enter the max. number of characters in ea. record"
S DIR("?")="Most analytic/graphics software can import 256 character records"
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
I X=U D BACKUP Q
D CK
I $D(AMQQQUIT) Q
I 'Y W "??",*7 G LEN
S AMQQEM("LEN")=Y
D FWD
Q
;
TYPE ; RECORD TYPE ; 5
S %=$P($G(AMQQEM("STUFF")),U,3)
I %=1 K AMQQEM("FIX") S AMQQEM("TYPE")=1 Q
I %=2 K AMQQEM("MLEN"),AMQQEM("HLEN") S AMQQERUN=7,AMQQEM("TYPE")=2 Q
D MARK
W "RECORD FORMAT",!
S DIR("B")=$S($D(AMQQEM("TYPE")):AMQQEM("TYPE"),1:1)
S DIR("??")="AMQQEMANFIXDEL"
S DIR(0)="S^1:DELIMITED;2:FIXED LENGTH"
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
I Y=2 K AMQQEM("DEL"),AMQQEM("MLEN") D FWD S AMQQERUN=7,AMQQEM("TYPE")=2 Q
K AMQQEM("FIX")
D FWD
S AMQQEM("TYPE")=1
Q
;
DEL ; DELIMITER CHARACTER ; 6
S %=$P($G(AMQQEM("STUFF")),U,4)
I %'="" S AMQQEM("DEL")=% Q
D MARK
W "DELIMITER CHARACTER",!
I $D(AMQQEM("DEL")) S DIR("B")=AMQQEM("DEL")
S DIR(0)="F^:^K:((X'=""UP ARROW"")&(X'=""TAB"")&((X'?1P)!(X=$C(34)))) X"
S DIR("A")="Enter the character to be used as a delimiter"
S DIR("?")="Usually the delimiter is a single non-alphanumeric character such as a comma or space. A quotation mark may not be used as a delimiter. Enter 'UP ARROW' to use '^' as a delimiter."
D ^DIR
K DIR
S:$D(DUOUT) DIRUT=1
I X=U D BACKUP Q
D CK
I $D(AMQQQUIT) Q
I Y'?1NUP,Y'="TAB",Y'="UP ARROW" W " ??",*7 G DEL
D FWD
S AMQQEM("DEL")=Y
Q
;
MLEN ; DEL FIELD LENGTH ; 7
S %=$P($G(AMQQEM("STUFF")),U,5)
I % S AMQQEM("MLEN")=%,AMQQERUN=8 Q
D MLEN^AMQQEM11
Q
;
FIX ; FIXED FIELD LENGTH ; 8
S %=$P($G(AMQQEM("STUFF")),U,7)
I % S AMQQEM("FIX")=% Q
D FIX^AMQQEM11
Q
;
HLEN ; DEL FIELD LENGTH ; 9
S %=$P($G(AMQQEM("STUFF")),U,6)
I % S AMQQEM("HLEN")=% Q
I '$D(AMQQEM("HLEN")),$D(AMQQEM("FIX")) S AMQQEM("HLEN")=AMQQEM("FIX")
D HLEN^AMQQEM11
Q
;
DATA ; ASSIGN DATA TYPE ; 10
S %=$P($G(AMQQEM("STUFF")),U,8)
I %'="" S AMQQEM("DATA")=% Q
D DATA^AMQQEM11
Q
;
ACCN ; ACCESSION NUMBER ; 11
D MARK
W "MAKE THE FIRST FIELD A SEQUENTIAL NUMBER",!
S DIR("B")=$S($D(AMQQEM("ACCN")):AMQQEM("ACCN"),1:"NO")
S DIR(0)="Y"
S DIR("A")="Want to make the 1st field a sequential (serial) number"
S DIR("?")="In some cases you may want to enter an serial number (starting with 1 and incrementing by 1 for each entry) as the first field of each record"
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("ACCN")=$S(Y:"YES",1:"NO")
Q
;
PATH ; PATH AND FILE...MSM ON ; 11
I ^DD("OS")=18 D Q
.S AMQQEX("PATH")=$P(^AMQQ(8,DUZ(2),0),U,12)
.I AMQQEX("PATH")="" D Q
..W !!,"No secured path available to save a host file."
..W !,"Contact your site manager for assistance."
..H 3
..S AMQQQUIT=""
.K DIR
.S DIR(0)="FO^3:50"
.S DIR("A")="Enter file name"
.S DIR("A",1)="File will be saved in '"_$P(^AMQQ(8,DUZ(2),0),U,12)_"'"
.W !!
.D ^DIR
.K DIR
.I X=""!(X[U) S AMQQQUIT="" Q
.S AMQQEX("FILE")=X
.S AMQQEX("PATH")=$P(^AMQQ(8,DUZ(2),0),U,12)
.K POP
.S POP=$$LIST^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"),.POP)
.I $G(POP(1))="" D CLOSE^%ZISH(),VAR Q
.D CLOSE^%ZISH()
.S DIR(0)="YO"
.S DIR("A")="File already exists. Replace it with new data"
.S DIR("B")="NO"
.W !!
.D ^DIR
.K DIR
.I 'Y G PATH
.S X=$$DEL^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"))
VAR .D VAR^AMQQEM1
D ^AMQQEM1
I '$D(AMQQQUIT),AMQQEM("FORMAT")="MUMPS" D NAME^AMQQEM4
I $D(AMQQFNMP) K AMQQFNMP,DUOUT,AMQQQUIT G PATH
Q
;
AMQQEMAN ; IHS/CMI/THL - Q-MAN TO DOS EXPORT UTILITY. BUILDS FLAT ASCII FILES ACCORDING TO SPECS. ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
RUN SET U="^"
+1 FOR AMQQERUN=1:1:11
DO @$PIECE("EXIT^INIT^STUFF^LEN^TYPE^DEL^MLEN^FIX^HLEN^DATA^PATH",U,AMQQERUN)
IF $DATA(AMQQQUIT)
QUIT
+2 ; FORMAT
IF '$DATA(AMQQQUIT)
DO ^AMQQEM2
+3 IF '$DATA(AMQQQUIT)
DO ^AMQQEM4
+4 KILL AMQQERUN,AMQQQUIT
EXIT ; - EP -
+1 KILL AMQQEMS,DIRUT,DUOUT,DTOUT,DIROUT,AMQQEM,%ZA,%ZB,AMQQEM,AMQQEMFS,AMQQEMP,AMQQEMS,AMQQEMZ,AMQQEMN,G,C,P,X,Y,Z,H,I,J,A,N,T,W,AMQQEFN,AMQQEMI,AMQQEMX
+2 QUIT
+3 ;
INIT IF '$DATA(DUZ(2))
WRITE !!,"Kernel variables not present...Session cancelled",*7,!!
SET AMQQQUIT=""
QUIT
+1 IF '$DATA(IOSL)
DO HOME^%ZIS
+2 SET %=$GET(AMQQCCLS)
+3 IF %'="P"
IF %'="V"
WRITE !!,"The subject of your search must be a PATIENT or a VISIT to create an ASCI file.",!,*7,"Sorry...",!!!
HANG 3
SET AMQQQUIT=""
QUIT
+4 SET AMQQEMS=""
+1 WRITE !!!,"You are about to create a flat, ASCII file in the MUMPS environment."
+2 WRITE !,"This file will be imported by your analytic/graphic software (e.g., dBase)."
+3 WRITE !!,"Before you create the file, please answer the following questions =>",!
+4 QUIT
+5 ;
STUFF ; 3
+1 DO MARK
+2 WRITE "EXPORT TO WHAT APPLICATION",!
+3 SET DIR(0)="P^9009073:EQM"
+4 SET DIR("A")="Select export format"
+5 SET DIR("B")="CUSTOM CONFIG"
+6 SET DIR("??")="AMQQEMANCONFIG"
+7 DO ^DIR
+8 KILL DIR
+9 IF $DATA(DUOUT)
SET DIRUT=1
+10 IF X=""
KILL AMQQEM("STUFF")
QUIT
+11 IF X?1."^"
SET AMQQQUIT=""
KILL DIRUT,DUOUT,DIROUT,DTOUT
QUIT
+12 IF Y["CUSTOM CONFIG"
KILL AMQQEM("STUFF")
DO FWD
QUIT
+13 SET AMQQEM("STUFF")=^AMQQ(3,+Y,0)
+14 DO FWD
+15 IF $GET(^AMQQ(3,+Y,2))]""
SET AMQQEM("DATE FORMAT")=^(2)
+16 QUIT
+17 ;
CK ; EP FROM MANY ROUTINES
+1 IF $DATA(DIRUT)!($DATA(DUOUT))!($DATA(DTOUT))!($DATA(DIROUT))!(X="^^")
KILL DIRUT,DUOUT,DTOUT,DIROUT
SET AMQQQUIT=""
+2 QUIT
+3 ;
MARK ; - EP -
+1 WRITE !!,"---------",!!
+2 QUIT
+3 ;
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 ;
LEN ; RECORD LENGTH ; 4
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,2)
+2 IF %
SET AMQQEM("LEN")=%
QUIT
+3 DO MARK
+4 WRITE "MAXIMUM RECORD LENGTH",!
+5 SET DIR("B")=$SELECT($DATA(AMQQEM("LEN")):AMQQEM("LEN"),1:256)
+6 SET DIR(0)="N^1:256:0"
+7 SET DIR("A")="Enter the max. number of characters in ea. record"
+8 SET DIR("?")="Most analytic/graphics software can import 256 character records"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DUOUT)
SET DIRUT=1
+12 IF X=U
DO BACKUP
QUIT
+13 DO CK
+14 IF $DATA(AMQQQUIT)
QUIT
+15 IF 'Y
WRITE "??",*7
GOTO LEN
+16 SET AMQQEM("LEN")=Y
+17 DO FWD
+18 QUIT
+19 ;
TYPE ; RECORD TYPE ; 5
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,3)
+2 IF %=1
KILL AMQQEM("FIX")
SET AMQQEM("TYPE")=1
QUIT
+3 IF %=2
KILL AMQQEM("MLEN"),AMQQEM("HLEN")
SET AMQQERUN=7
SET AMQQEM("TYPE")=2
QUIT
+4 DO MARK
+5 WRITE "RECORD FORMAT",!
+6 SET DIR("B")=$SELECT($DATA(AMQQEM("TYPE")):AMQQEM("TYPE"),1:1)
+7 SET DIR("??")="AMQQEMANFIXDEL"
+8 SET DIR(0)="S^1:DELIMITED;2:FIXED LENGTH"
+9 SET DIR("A")=" Your choice"
+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=2
KILL AMQQEM("DEL"),AMQQEM("MLEN")
DO FWD
SET AMQQERUN=7
SET AMQQEM("TYPE")=2
QUIT
+17 KILL AMQQEM("FIX")
+18 DO FWD
+19 SET AMQQEM("TYPE")=1
+20 QUIT
+21 ;
DEL ; DELIMITER CHARACTER ; 6
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,4)
+2 IF %'=""
SET AMQQEM("DEL")=%
QUIT
+3 DO MARK
+4 WRITE "DELIMITER CHARACTER",!
+5 IF $DATA(AMQQEM("DEL"))
SET DIR("B")=AMQQEM("DEL")
+6 SET DIR(0)="F^:^K:((X'=""UP ARROW"")&(X'=""TAB"")&((X'?1P)!(X=$C(34)))) X"
+7 SET DIR("A")="Enter the character to be used as a delimiter"
+8 SET DIR("?")="Usually the delimiter is a single non-alphanumeric character such as a comma or space. A quotation mark may not be used as a delimiter. Enter 'UP ARROW' to use '^' as a delimiter."
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DUOUT)
SET DIRUT=1
+12 IF X=U
DO BACKUP
QUIT
+13 DO CK
+14 IF $DATA(AMQQQUIT)
QUIT
+15 IF Y'?1NUP
IF Y'="TAB"
IF Y'="UP ARROW"
WRITE " ??",*7
GOTO DEL
+16 DO FWD
+17 SET AMQQEM("DEL")=Y
+18 QUIT
+19 ;
MLEN ; DEL FIELD LENGTH ; 7
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,5)
+2 IF %
SET AMQQEM("MLEN")=%
SET AMQQERUN=8
QUIT
+3 DO MLEN^AMQQEM11
+4 QUIT
+5 ;
FIX ; FIXED FIELD LENGTH ; 8
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,7)
+2 IF %
SET AMQQEM("FIX")=%
QUIT
+3 DO FIX^AMQQEM11
+4 QUIT
+5 ;
HLEN ; DEL FIELD LENGTH ; 9
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,6)
+2 IF %
SET AMQQEM("HLEN")=%
QUIT
+3 IF '$DATA(AMQQEM("HLEN"))
IF $DATA(AMQQEM("FIX"))
SET AMQQEM("HLEN")=AMQQEM("FIX")
+4 DO HLEN^AMQQEM11
+5 QUIT
+6 ;
DATA ; ASSIGN DATA TYPE ; 10
+1 SET %=$PIECE($GET(AMQQEM("STUFF")),U,8)
+2 IF %'=""
SET AMQQEM("DATA")=%
QUIT
+3 DO DATA^AMQQEM11
+4 QUIT
+5 ;
ACCN ; ACCESSION NUMBER ; 11
+1 DO MARK
+2 WRITE "MAKE THE FIRST FIELD A SEQUENTIAL NUMBER",!
+3 SET DIR("B")=$SELECT($DATA(AMQQEM("ACCN")):AMQQEM("ACCN"),1:"NO")
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Want to make the 1st field a sequential (serial) number"
+6 SET DIR("?")="In some cases you may want to enter an serial number (starting with 1 and incrementing by 1 for each entry) as the first field of each record"
+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 DO FWD
+14 SET AMQQEM("ACCN")=$SELECT(Y:"YES",1:"NO")
+15 QUIT
+16 ;
PATH ; PATH AND FILE...MSM ON ; 11
+1 IF ^DD("OS")=18
Begin DoDot:1
+2 SET AMQQEX("PATH")=$PIECE(^AMQQ(8,DUZ(2),0),U,12)
+3 IF AMQQEX("PATH")=""
Begin DoDot:2
+4 WRITE !!,"No secured path available to save a host file."
+5 WRITE !,"Contact your site manager for assistance."
+6 HANG 3
+7 SET AMQQQUIT=""
End DoDot:2
QUIT
+8 KILL DIR
+9 SET DIR(0)="FO^3:50"
+10 SET DIR("A")="Enter file name"
+11 SET DIR("A",1)="File will be saved in '"_$PIECE(^AMQQ(8,DUZ(2),0),U,12)_"'"
+12 WRITE !!
+13 DO ^DIR
+14 KILL DIR
+15 IF X=""!(X[U)
SET AMQQQUIT=""
QUIT
+16 SET AMQQEX("FILE")=X
+17 SET AMQQEX("PATH")=$PIECE(^AMQQ(8,DUZ(2),0),U,12)
+18 KILL POP
+19 SET POP=$$LIST^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"),.POP)
+20 IF $GET(POP(1))=""
DO CLOSE^%ZISH()
DO VAR
QUIT
+21 DO CLOSE^%ZISH()
+22 SET DIR(0)="YO"
+23 SET DIR("A")="File already exists. Replace it with new data"
+24 SET DIR("B")="NO"
+25 WRITE !!
+26 DO ^DIR
+27 KILL DIR
+28 IF 'Y
GOTO PATH
+29 SET X=$$DEL^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"))
VAR DO VAR^AMQQEM1
End DoDot:1
QUIT
+1 DO ^AMQQEM1
+2 IF '$DATA(AMQQQUIT)
IF AMQQEM("FORMAT")="MUMPS"
DO NAME^AMQQEM4
+3 IF $DATA(AMQQFNMP)
KILL AMQQFNMP,DUOUT,AMQQQUIT
GOTO PATH
+4 QUIT
+5 ;
