Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMQQEMAN

AMQQEMAN.m

Go to the documentation of this file. 
  1. 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
  1.  ;-----
  1. RUN S U="^"
  1.  F AMQQERUN=1:1:11 D @$P("EXIT^INIT^STUFF^LEN^TYPE^DEL^MLEN^FIX^HLEN^DATA^PATH",U,AMQQERUN) I $D(AMQQQUIT) Q
  1.  I '$D(AMQQQUIT) D ^AMQQEM2 ; FORMAT
  1.  I '$D(AMQQQUIT) D ^AMQQEM4
  1.  K AMQQERUN,AMQQQUIT
  1. EXIT ; - EP -
  1.  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
  1.  Q
  1.  ;
  1. INIT I '$D(DUZ(2)) W !!,"Kernel variables not present...Session cancelled",*7,!! S AMQQQUIT="" Q
  1.  I '$D(IOSL) D HOME^%ZIS
  1.  S %=$G(AMQQCCLS)
  1.  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
  1.  S AMQQEMS=""
  1.  W !!!,"You are about to create a flat, ASCII file in the MUMPS environment."
  1.  W !,"This file will be imported by your analytic/graphic software (e.g., dBase)."
  1.  W !!,"Before you create the file, please answer the following questions =>",!
  1.  Q
  1.  ;
  1. STUFF ; 3
  1.  D MARK
  1.  W "EXPORT TO WHAT APPLICATION",!
  1.  S DIR(0)="P^9009073:EQM"
  1.  S DIR("A")="Select export format"
  1.  S DIR("B")="CUSTOM CONFIG"
  1.  S DIR("??")="AMQQEMANCONFIG"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X="" K AMQQEM("STUFF") Q
  1.  I X?1."^" S AMQQQUIT="" K DIRUT,DUOUT,DIROUT,DTOUT Q
  1.  I Y["CUSTOM CONFIG" K AMQQEM("STUFF") D FWD Q
  1.  S AMQQEM("STUFF")=^AMQQ(3,+Y,0)
  1.  D FWD
  1.  I $G(^AMQQ(3,+Y,2))]"" S AMQQEM("DATE FORMAT")=^(2)
  1.  Q
  1.  ;
  1. CK ; EP FROM MANY ROUTINES
  1.  I $D(DIRUT)!($D(DUOUT))!($D(DTOUT))!($D(DIROUT))!(X="^^") K DIRUT,DUOUT,DTOUT,DIROUT S AMQQQUIT=""
  1.  Q
  1.  ;
  1. MARK ; - EP -
  1.  W !!,"---------",!!
  1.  Q
  1.  ;
  1. FWD S AMQQEMS=AMQQERUN_U_AMQQEMS
  1.  Q
  1.  ;
  1. BACKUP S AMQQERUN=$P(AMQQEMS,U)-1
  1.  S AMQQEMS=$P(AMQQEMS,U,2,99)
  1.  Q
  1.  ;
  1. LEN ; RECORD LENGTH ; 4
  1.  S %=$P($G(AMQQEM("STUFF")),U,2)
  1.  I % S AMQQEM("LEN")=% Q
  1.  D MARK
  1.  W "MAXIMUM RECORD LENGTH",!
  1.  S DIR("B")=$S($D(AMQQEM("LEN")):AMQQEM("LEN"),1:256)
  1.  S DIR(0)="N^1:256:0"
  1.  S DIR("A")="Enter the max. number of characters in ea. record"
  1.  S DIR("?")="Most analytic/graphics software can import 256 character records"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X=U D BACKUP Q
  1.  D CK
  1.  I $D(AMQQQUIT) Q
  1.  I 'Y W "??",*7 G LEN
  1.  S AMQQEM("LEN")=Y
  1.  D FWD
  1.  Q
  1.  ;
  1. TYPE ; RECORD TYPE ; 5
  1.  S %=$P($G(AMQQEM("STUFF")),U,3)
  1.  I %=1 K AMQQEM("FIX") S AMQQEM("TYPE")=1 Q
  1.  I %=2 K AMQQEM("MLEN"),AMQQEM("HLEN") S AMQQERUN=7,AMQQEM("TYPE")=2 Q
  1.  D MARK
  1.  W "RECORD FORMAT",!
  1.  S DIR("B")=$S($D(AMQQEM("TYPE")):AMQQEM("TYPE"),1:1)
  1.  S DIR("??")="AMQQEMANFIXDEL"
  1.  S DIR(0)="S^1:DELIMITED;2:FIXED LENGTH"
  1.  S DIR("A")="     Your choice"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X=U D BACKUP Q
  1.  D CK
  1.  I $D(AMQQQUIT) Q
  1.  I Y=2 K AMQQEM("DEL"),AMQQEM("MLEN") D FWD S AMQQERUN=7,AMQQEM("TYPE")=2 Q
  1.  K AMQQEM("FIX")
  1.  D FWD
  1.  S AMQQEM("TYPE")=1
  1.  Q
  1.  ;
  1. DEL ; DELIMITER CHARACTER ; 6
  1.  S %=$P($G(AMQQEM("STUFF")),U,4)
  1.  I %'="" S AMQQEM("DEL")=% Q
  1.  D MARK
  1.  W "DELIMITER CHARACTER",!
  1.  I $D(AMQQEM("DEL")) S DIR("B")=AMQQEM("DEL")
  1.  S DIR(0)="F^:^K:((X'=""UP ARROW"")&(X'=""TAB"")&((X'?1P)!(X=$C(34)))) X"
  1.  S DIR("A")="Enter the character to be used as a delimiter"
  1.  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."
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X=U D BACKUP Q
  1.  D CK
  1.  I $D(AMQQQUIT) Q
  1.  I Y'?1NUP,Y'="TAB",Y'="UP ARROW" W " ??",*7 G DEL
  1.  D FWD
  1.  S AMQQEM("DEL")=Y
  1.  Q
  1.  ;
  1. MLEN ; DEL FIELD LENGTH ; 7
  1.  S %=$P($G(AMQQEM("STUFF")),U,5)
  1.  I % S AMQQEM("MLEN")=%,AMQQERUN=8 Q
  1.  D MLEN^AMQQEM11
  1.  Q
  1.  ;
  1. FIX ; FIXED FIELD LENGTH ; 8
  1.  S %=$P($G(AMQQEM("STUFF")),U,7)
  1.  I % S AMQQEM("FIX")=% Q
  1.  D FIX^AMQQEM11
  1.  Q
  1.  ;
  1. HLEN ; DEL FIELD LENGTH ; 9
  1.  S %=$P($G(AMQQEM("STUFF")),U,6)
  1.  I % S AMQQEM("HLEN")=% Q
  1.  I '$D(AMQQEM("HLEN")),$D(AMQQEM("FIX")) S AMQQEM("HLEN")=AMQQEM("FIX")
  1.  D HLEN^AMQQEM11
  1.  Q
  1.  ;
  1. DATA ; ASSIGN DATA TYPE ; 10
  1.  S %=$P($G(AMQQEM("STUFF")),U,8)
  1.  I %'="" S AMQQEM("DATA")=% Q
  1.  D DATA^AMQQEM11
  1.  Q
  1.  ;
  1. ACCN ; ACCESSION NUMBER ; 11
  1.  D MARK
  1.  W "MAKE THE FIRST FIELD A SEQUENTIAL NUMBER",!
  1.  S DIR("B")=$S($D(AMQQEM("ACCN")):AMQQEM("ACCN"),1:"NO")
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Want to make the 1st field a sequential (serial) number"
  1.  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"
  1.  D ^DIR
  1.  K DIR
  1.  S:$D(DUOUT) DIRUT=1
  1.  I X=U D BACKUP Q
  1.  D CK
  1.  I $D(AMQQQUIT) Q
  1.  D FWD
  1.  S AMQQEM("ACCN")=$S(Y:"YES",1:"NO")
  1.  Q
  1.  ;
  1. PATH ; PATH AND FILE...MSM ON ; 11
  1.  I ^DD("OS")=18 D  Q
  1.  .S AMQQEX("PATH")=$P(^AMQQ(8,DUZ(2),0),U,12)
  1.  .I AMQQEX("PATH")="" D  Q
  1.  ..W !!,"No secured path available to save a host file."
  1.  ..W !,"Contact your site manager for assistance."
  1.  ..H 3
  1.  ..S AMQQQUIT=""
  1.  .K DIR
  1.  .S DIR(0)="FO^3:50"
  1.  .S DIR("A")="Enter file name"
  1.  .S DIR("A",1)="File will be saved in '"_$P(^AMQQ(8,DUZ(2),0),U,12)_"'"
  1.  .W !!
  1.  .D ^DIR
  1.  .K DIR
  1.  .I X=""!(X[U) S AMQQQUIT="" Q
  1.  .S AMQQEX("FILE")=X
  1.  .S AMQQEX("PATH")=$P(^AMQQ(8,DUZ(2),0),U,12)
  1.  .K POP
  1.  .S POP=$$LIST^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"),.POP)
  1.  .I $G(POP(1))="" D CLOSE^%ZISH(),VAR Q
  1.  .D CLOSE^%ZISH()
  1.  .S DIR(0)="YO"
  1.  .S DIR("A")="File already exists.  Replace it with new data"
  1.  .S DIR("B")="NO"
  1.  .W !!
  1.  .D ^DIR
  1.  .K DIR
  1.  .I 'Y G PATH
  1.  .S X=$$DEL^%ZISH(AMQQEX("PATH"),AMQQEX("FILE"))
  1. VAR .D VAR^AMQQEM1
  1.  D ^AMQQEM1
  1.  I '$D(AMQQQUIT),AMQQEM("FORMAT")="MUMPS" D NAME^AMQQEM4
  1.  I $D(AMQQFNMP) K AMQQFNMP,DUOUT,AMQQQUIT G PATH
  1.  Q
  1.  ;