ACDTX5.m

ACDTX5 ;IHS/ADC/EDE/KML - SAVE ACDGTMP TO UNIX/DOS FILE; 

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 K ACDTIME

 D ^XBKVAR,NOW^%DTC

 ;S XBDT=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3)

 S XBDT=DT

V ;

 I '$D(ACDTIME) S ACDTIME=DTIME,DTIME=9000000000

 K XBMED

 ;

 ;Check for extract data found

 I '$D(^ACDGTMP) W !!,"No new data found to extract....." Q

 ;

 ;Set up 0 node of extract now that we know there was data found

 S $P(^ACDGTMP(0),U)=ACDFR,$P(^(0),U,2)=ACDTO

 ;

 W !!,"Saving Data now....."

 S XBMED="F"

 S XBGL="ACDGTMP"

 D ^XBGSAVE

 ;I XBFLG W !!,*7,"Up Arrow not allowed." G V

 S DTIME=ACDTIME

 K XBMED,ACDTIME

 K ^ACDGTMP ;         kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

 Q

 ;

PGM ;EP - PGM data (1 time a year send)

 ;I '$D(ACDTIME) S ACDTIME=DTIME,DTIME=9000000000

 ;K XBMED

 ;I '$D(^ACDPDATA) W !,"*** No new data to extract from file *** " Q

 ;I ^%ZOSF("OS")["UNIX"!(^%ZOSF("OS")["PC") S XBMED="F"

 ;D ^XBKVAR,NOW^%DTC

 ;S XBDT=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3)

 ;S XBGL="ACDPDATA"

 ;D ^XBGSAVE

 ;I XBFLG W !!,*7,"Up Arrow Not Allowed." G PGM

 ;S DTIME=ACDTIME

 ;K XBMED,^ACDPDATA,ACDTIME

ACDTX5    ;IHS/ADC/EDE/KML - SAVE ACDGTMP TO UNIX/DOS FILE; 

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2        KILL ACDTIME

 +3        DO ^XBKVAR

           DO NOW^%DTC

 +4       ;S XBDT=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3)

 +5        SET XBDT=DT

V         ;

 +1        IF '$DATA(ACDTIME)

               SET ACDTIME=DTIME

               SET DTIME=9000000000

 +2        KILL XBMED

 +3       ;

 +4       ;Check for extract data found

 +5        IF '$DATA(^ACDGTMP)

               WRITE !!,"No new data found to extract....."

               QUIT 

 +6       ;

 +7       ;Set up 0 node of extract now that we know there was data found

 +8        SET $PIECE(^ACDGTMP(0),U)=ACDFR

           SET $PIECE(^(0),U,2)=ACDTO

 +9       ;

 +10       WRITE !!,"Saving Data now....."

 +11       SET XBMED="F"

 +12       SET XBGL="ACDGTMP"

 +13       DO ^XBGSAVE

 +14      ;I XBFLG W !!,*7,"Up Arrow not allowed." G V

 +15       SET DTIME=ACDTIME

 +16       KILL XBMED,ACDTIME

 +17      ;         kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

           KILL ^ACDGTMP

 +18       QUIT 

 +19      ;

PGM       ;EP - PGM data (1 time a year send)

 +1       ;I '$D(ACDTIME) S ACDTIME=DTIME,DTIME=9000000000

 +2       ;K XBMED

 +3       ;I '$D(^ACDPDATA) W !,"*** No new data to extract from file *** " Q

 +4       ;I ^%ZOSF("OS")["UNIX"!(^%ZOSF("OS")["PC") S XBMED="F"

 +5       ;D ^XBKVAR,NOW^%DTC

 +6       ;S XBDT=%I(1)_"/"_%I(2)_"/"_$E(%I(3),2,3)

 +7       ;S XBGL="ACDPDATA"

 +8       ;D ^XBGSAVE

 +9       ;I XBFLG W !!,*7,"Up Arrow Not Allowed." G PGM

 +10      ;S DTIME=ACDTIME

 +11      ;K XBMED,^ACDPDATA,ACDTIME