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

AMQQEM5.m

Go to the documentation of this file.
  1. AMQQEM5 ; IHS/CMI/THL - EMAN OPTIONS ;
  1. ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1. ;-----
  1. EN ; ENTRY POINT FOR EXPORT OF DATA FROM ^AMQQ(3.1,
  1. S DIC="^AMQQ(3.1,"
  1. S DIC(0)="AEQM"
  1. S DIC("A")="File name: "
  1. D ^DIC
  1. K DIC
  1. I Y=-1 G ENX
  1. I '$D(^AMQQ(3.1,+Y,2,1,0)) G DATA
  1. W !!,"Get ready to receive the reference file (approx 1K)....."
  1. R !!,"Press the <return> key to initiate data transfer",X:DTIME E G ENX
  1. I X?1."^" G ENX
  1. W !!
  1. F %=0:0 S %=$O(^AMQQ(3.1,+Y,2,%)) Q:'% W ^(%,0),!
  1. DATA W @IOF,!!,"Get ready to receive the data file......."
  1. R !!,"Press the <return> key to initiate data transfer",X:DTIME E G ENX
  1. I X?1."^" G ENX
  1. F %=0:0 S %=$O(^AMQQ(3.1,+Y,1,%)) Q:'% W ^(%,0),!
  1. ENX W @IOF
  1. K DUOUT,DTOUT,X,Y
  1. Q
  1. ;
  1. EN1 ;EP FOR PURGING EXPORT DATA FILE
  1. N AMQQEMPG
  1. W:$D(IOF) @IOF W !,?15,"***** PURGE MUMPS EXPORT DATA FILE *****",!!!
  1. EN11 S DIR(0)="PO^9009073.1:EQM"
  1. S DIR("A")="Select MUMPS data file to purge"
  1. D ^DIR
  1. K DIR
  1. I $D(DIRUT)!($D(DIROUT)) K DIRUT,DIROUT,DUOUT,DTOUT Q
  1. S AMQQEMPG=+Y
  1. W !!,"MUMPS data file: ",$P(Y,U,2),!,"Created by: "
  1. S %=$P(^AMQQ(3.1,+Y,0),U,2)
  1. S %=$P($G(@AMQQ200(3)@(+$G(%),0)),U)
  1. S:%="" %="??"
  1. W %
  1. W !,"Entered on: "
  1. S Y=$P(^AMQQ(3.1,+Y,0),U,3)
  1. X ^DD("DD")
  1. W Y,!!
  1. 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
  1. S DIR(0)="YO"
  1. S DIR("A")="Are you sure"
  1. D ^DIR
  1. K DIR
  1. I $D(DIRUT)!($D(DIROUT)) K DIROUT,DIRUT,DUOUT,DTOUT Q
  1. I 'Y G EN11
  1. S DA=AMQQEMPG
  1. S DIK="^AMQQ(3.1,"
  1. D ^DIK
  1. K DIK,DIC,DA
  1. 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
  1. I Y G EN11
  1. K DIRUT,DIROUT,DUOUT,DTOUT
  1. Q
  1. ;