- 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 ;