AMQQEM5 ; IHS/CMI/THL - EMAN OPTIONS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;-----
EN ; ENTRY POINT FOR EXPORT OF DATA FROM ^AMQQ(3.1,
S DIC="^AMQQ(3.1,"
S DIC(0)="AEQM"
S DIC("A")="File name: "
D ^DIC
K DIC
I Y=-1 G ENX
I '$D(^AMQQ(3.1,+Y,2,1,0)) G DATA
W !!,"Get ready to receive the reference file (approx 1K)....."
R !!,"Press the <return> key to initiate data transfer",X:DTIME E G ENX
I X?1."^" G ENX
W !!
F %=0:0 S %=$O(^AMQQ(3.1,+Y,2,%)) Q:'% W ^(%,0),!
DATA W @IOF,!!,"Get ready to receive the data file......."
R !!,"Press the <return> key to initiate data transfer",X:DTIME E G ENX
I X?1."^" G ENX
F %=0:0 S %=$O(^AMQQ(3.1,+Y,1,%)) Q:'% W ^(%,0),!
ENX W @IOF
K DUOUT,DTOUT,X,Y
Q
;
EN1 ;EP FOR PURGING EXPORT DATA FILE
N AMQQEMPG
W:$D(IOF) @IOF W !,?15,"***** PURGE MUMPS EXPORT DATA FILE *****",!!!
EN11 S DIR(0)="PO^9009073.1:EQM"
S DIR("A")="Select MUMPS data file to purge"
D ^DIR
K DIR
I $D(DIRUT)!($D(DIROUT)) K DIRUT,DIROUT,DUOUT,DTOUT Q
S AMQQEMPG=+Y
W !!,"MUMPS data file: ",$P(Y,U,2),!,"Created by: "
S %=$P(^AMQQ(3.1,+Y,0),U,2)
S %=$P($G(@AMQQ200(3)@(+$G(%),0)),U)
S:%="" %="??"
W %
W !,"Entered on: "
S Y=$P(^AMQQ(3.1,+Y,0),U,3)
X ^DD("DD")
W Y,!!
I $P(^AMQQ(3.1,AMQQEMPG,0),U,2)'=DUZ W !!,"You are not allowed to purge anyone else's MUMPS data file.",*7,!! G EN11
S DIR(0)="YO"
S DIR("A")="Are you sure"
D ^DIR
K DIR
I $D(DIRUT)!($D(DIROUT)) K DIROUT,DIRUT,DUOUT,DTOUT Q
I 'Y G EN11
S DA=AMQQEMPG
S DIK="^AMQQ(3.1,"
D ^DIK
K DIK,DIC,DA
I $D(AMQQ(3.1,"B")) S DIR(0)="YO",DIR("A")="Want to purge another" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y G EN11
K DIRUT,DIROUT,DUOUT,DTOUT
Q
;
AMQQEM5 ; IHS/CMI/THL - EMAN OPTIONS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;-----
EN ; ENTRY POINT FOR EXPORT OF DATA FROM ^AMQQ(3.1,
+1 SET DIC="^AMQQ(3.1,"
+2 SET DIC(0)="AEQM"
+3 SET DIC("A")="File name: "
+4 DO ^DIC
+5 KILL DIC
+6 IF Y=-1
GOTO ENX
+7 IF '$DATA(^AMQQ(3.1,+Y,2,1,0))
GOTO DATA
+8 WRITE !!,"Get ready to receive the reference file (approx 1K)....."
+9 READ !!,"Press the <return> key to initiate data transfer",X:DTIME
IF '$TEST
GOTO ENX
+10 IF X?1."^"
GOTO ENX
+11 WRITE !!
+12 FOR %=0:0
SET %=$ORDER(^AMQQ(3.1,+Y,2,%))
IF '%
QUIT
WRITE ^(%,0),!
DATA WRITE @IOF,!!,"Get ready to receive the data file......."
+1 READ !!,"Press the <return> key to initiate data transfer",X:DTIME
IF '$TEST
GOTO ENX
+2 IF X?1."^"
GOTO ENX
+3 FOR %=0:0
SET %=$ORDER(^AMQQ(3.1,+Y,1,%))
IF '%
QUIT
WRITE ^(%,0),!
ENX WRITE @IOF
+1 KILL DUOUT,DTOUT,X,Y
+2 QUIT
+3 ;
EN1 ;EP FOR PURGING EXPORT DATA FILE
+1 NEW AMQQEMPG
+2 IF $DATA(IOF)
WRITE @IOF
WRITE !,?15,"***** PURGE MUMPS EXPORT DATA FILE *****",!!!
EN11 SET DIR(0)="PO^9009073.1:EQM"
+1 SET DIR("A")="Select MUMPS data file to purge"
+2 DO ^DIR
+3 KILL DIR
+4 IF $DATA">DATA(DIRUT)!($DATA">DATA(DIROUT))
KILL DIRUT,DIROUT,DUOUT,DTOUT
QUIT
+5 SET AMQQEMPG=+Y
+6 WRITE !!,"MUMPS data file: ",$PIECE(Y,U,2),!,"Created by: "
+7 SET %=$PIECE(^AMQQ(3.1,+Y,0),U,2)
+8 SET %=$PIECE($GET(@AMQQ200(3)@(+$GET(%),0)),U)
+9 IF %=""
SET %="??"
+10 WRITE %
+11 WRITE !,"Entered on: "
+12 SET Y=$PIECE(^AMQQ(3.1,+Y,0),U,3)
+13 XECUTE ^DD("DD")
+14 WRITE Y,!!
+15 IF $PIECE(^AMQQ(3.1,AMQQEMPG,0),U,2)'=DUZ
WRITE !!,"You are not allowed to purge anyone else's MUMPS data file.",*7,!!
GOTO EN11
+16 SET DIR(0)="YO"
+17 SET DIR("A")="Are you sure"
+18 DO ^DIR
+19 KILL DIR
+20 IF $DATA">DATA(DIRUT)!($DATA">DATA(DIROUT))
KILL DIROUT,DIRUT,DUOUT,DTOUT
QUIT
+21 IF 'Y
GOTO EN11
+22 SET DA=AMQQEMPG
+23 SET DIK="^AMQQ(3.1,"
+24 DO ^DIK
+25 KILL DIK,DIC,DA
+26 IF $DATA(AMQQ(3.1,"B"))
SET DIR(0)="YO"
SET DIR("A")="Want to purge another"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+27 IF Y
GOTO EN11
+28 KILL DIRUT,DIROUT,DUOUT,DTOUT
+29 QUIT
+30 ;
