- ACDPSAVE ;IHS/ADC/EDE/KML - EXTRACT PROGRAM DATA TO A HOST FILE OR MAIL SERVER;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;
- EN ;EP
- ;//[ACD SUPER8]
- ;
- D EN5^ACDV4MES
- ;
- ;Chk for incomplete import.
- I $D(^ACDP1TMP) W !!,*7,*7,"A data import still exists in the ^ACDPTMP global due to a",!,"CORRUPT LOCATION FILE ** I MUST STOP **" D K Q
- ;
- ;Initialize ^ACDPTMP
- I $D(^ACDPTMP) W !!,*7,*7,"It seems an extract is presently running." D K Q
- K ^ACDPTMP ; kill of scratch global SAC EXEMPTION (2.3.2.3 killing of unsubscripted globals is prohibited)
- ;
- ;Ask transmission mode
- ; commented out net mail option per Wilbur Woodis
- ;K ACDMAIL S DIR(0)="S^1:TRANSMIT DATA VIA UNIX FILE;2:TRANSMIT DATA VIA NET MAIL" D ^DIR G:X["^"!($D(DTOUT)!(X="")) K
- ;I Y=2 S ACDMAIL=1 D
- ;.I '$O(^ACDOMAIN(DUZ(2),1,0)) W !!,*7,*7,"You must set domains to send extracted data to." D EN^ACDSRV3
- ;.S ACDSRVOP=1 D DOM^ACDSRV3 I '$D(XMY) W !!,*7,*7,"No domains are defined to send the extraction data to.",!,"I cannot continue because of this." S ACDQUIT=1
- ;I $D(ACDQUIT) D K Q
- F W !!,"OK to continue" S %=2 D YN^DICN W:%=0 " Answer Yes or No" G:%'=1&(%'=0) K Q:%=1
- F ACDA=0:0 S ACDA=$O(^ACDQAN(ACDA)) Q:'ACDA D
- .;
- .S ACD6PGM=$P(^AUTTLOC(ACDA,0),U,10)
- .S ACDUSER=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,10)_"*"_ACD6PGM
- .S %X="^ACDQAN("_ACDA_","
- .S %Y="^ACDPTMP("""_ACDUSER_""","
- .;
- .D %XY^%RCR
- ;
- ;
- ;Create host file
- I '$D(^ACDPTMP) W !!,"No new data found." G K
- I '$D(ACDMAIL) S $P(^ACDPTMP(0),U)="PROGRAM DATA",$P(^(0),U,2)="PROGRAM DATA",$P(^(0),U,20)="IMPORT FILE",XBGL="ACDPTMP" D EN^ACDGX5
- ;Use net mail
- I $D(ACDMAIL) S (ACDFR,ACDTO)="PROGRAM DATA" D ^ACDPSRV0
- ;
- W !!,"Now deleting the ^ACDPTMP global....."
- K ^ACDPTMP ; kill of scratch global SAC EXEMPTION (2.3.2.3 killing of unsubscripted globals is prohibited)
- W !,"CDMIS data extraction successfully completed."
- K ;
- K ACDV,ACDUSER,ACDBWP,ACDDA,ACDFR,ACDTO,ACD,ACDDRUG,ACD6PGM,ACDRUG,ACDTIME,ACDPOINT,X,Y,DIE,DIC,DIK,ACDA,DIR
- ACDPSAVE ;IHS/ADC/EDE/KML - EXTRACT PROGRAM DATA TO A HOST FILE OR MAIL SERVER;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;
- EN ;EP
- +1 ;//[ACD SUPER8]
- +2 ;
- +3 DO EN5^ACDV4MES
- +4 ;
- +5 ;Chk for incomplete import.
- +6 IF $DATA(^ACDP1TMP)
- WRITE !!,*7,*7,"A data import still exists in the ^ACDPTMP global due to a",!,"CORRUPT LOCATION FILE ** I MUST STOP **"
- DO K
- QUIT
- +7 ;
- +8 ;Initialize ^ACDPTMP
- +9 IF $DATA(^ACDPTMP)
- WRITE !!,*7,*7,"It seems an extract is presently running."
- DO K
- QUIT
- +10 ; kill of scratch global SAC EXEMPTION (2.3.2.3 killing of unsubscripted globals is prohibited)
- KILL ^ACDPTMP
- +11 ;
- +12 ;Ask transmission mode
- +13 ; commented out net mail option per Wilbur Woodis
- +14 ;K ACDMAIL S DIR(0)="S^1:TRANSMIT DATA VIA UNIX FILE;2:TRANSMIT DATA VIA NET MAIL" D ^DIR G:X["^"!($D(DTOUT)!(X="")) K
- +15 ;I Y=2 S ACDMAIL=1 D
- +16 ;.I '$O(^ACDOMAIN(DUZ(2),1,0)) W !!,*7,*7,"You must set domains to send extracted data to." D EN^ACDSRV3
- +17 ;.S ACDSRVOP=1 D DOM^ACDSRV3 I '$D(XMY) W !!,*7,*7,"No domains are defined to send the extraction data to.",!,"I cannot continue because of this." S ACDQUIT=1
- +18 ;I $D(ACDQUIT) D K Q
- +19 FOR
- WRITE !!,"OK to continue"
- SET %=2
- DO YN^DICN
- IF %=0
- WRITE " Answer Yes or No"
- IF %'=1&(%'=0)
- GOTO K
- IF %=1
- QUIT
- +20 FOR ACDA=0:0
- SET ACDA=$ORDER(^ACDQAN(ACDA))
- IF 'ACDA
- QUIT
- Begin DoDot:1
- +21 ;
- +22 SET ACD6PGM=$PIECE(^AUTTLOC(ACDA,0),U,10)
- +23 SET ACDUSER=$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,10)_"*"_ACD6PGM
- +24 SET %X="^ACDQAN("_ACDA_","
- +25 SET %Y="^ACDPTMP("""_ACDUSER_""","
- +26 ;
- +27 DO %XY^%RCR
- End DoDot:1
- +28 ;
- +29 ;
- +30 ;Create host file
- +31 IF '$DATA(^ACDPTMP)
- WRITE !!,"No new data found."
- GOTO K
- +32 IF '$DATA(ACDMAIL)
- SET $PIECE(^ACDPTMP(0),U)="PROGRAM DATA"
- SET $PIECE(^(0),U,2)="PROGRAM DATA"
- SET $PIECE(^(0),U,20)="IMPORT FILE"
- SET XBGL="ACDPTMP"
- DO EN^ACDGX5
- +33 ;Use net mail
- +34 IF $DATA(ACDMAIL)
- SET (ACDFR,ACDTO)="PROGRAM DATA"
- DO ^ACDPSRV0
- +35 ;
- +36 WRITE !!,"Now deleting the ^ACDPTMP global....."
- +37 ; kill of scratch global SAC EXEMPTION (2.3.2.3 killing of unsubscripted globals is prohibited)
- KILL ^ACDPTMP
- +38 WRITE !,"CDMIS data extraction successfully completed."
- K ;
- +1 KILL ACDV,ACDUSER,ACDBWP,ACDDA,ACDFR,ACDTO,ACD,ACDDRUG,ACD6PGM,ACDRUG,ACDTIME,ACDPOINT,X,Y,DIE,DIC,DIK,ACDA,DIR
