ACDPSAVE.m

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