- ADEXSU0 ; IHS/HQT/MJL - DENTAL EXTRACT PART 2 ; [ 05/12/1999 5:04 PM ]
- ;;6.0;ADE;**1**;MAY 12, 1999
- ADEXCK ;EP
- G:'$D(^ADENDATA) OK
- G:$D(^ADENDATA(0)) ADEX1 W !,"The data storage area contains an incomplete file of previously extracted data."
- ADEX R !,"Ok if I erase it? N//",X:DTIME S:'$T X=U S X=$E(X_"N")
- I X["?" W !,"The incomplete data file was probably created during an aborted extraction",!,"attempt." G ADEX
- I "Yy"'[X W !," -- data extraction cancelled." G QUIT
- G OK
- ADEX1 W !,"Data extracted on " S Y=$P(^ADENDATA(0),U,3) S:$L(Y)=8 Y=Y-17000000 X ^DD("DD") W Y," is still stored.",!,"It will be erased if you continue.",!
- ;MJL On previous line subtracted 17 Million from CCYYMMDD formatted date to convert to FM internal date so ^DD("DD") could return a valid date
- CONFIRM R "Ok to continue? N// ",X:DTIME S:'$T X=U S X=$E(X_"N")
- I X["?" W !,"It is ok to clear the data extraction holding file if the data",!,"has already been forwarded to Area for processing.",! G CONFIRM
- I "Yy"'[X W " -- data extraction cancelled.",! G QUIT
- OK G:$D(ADEREX) ASKDEV
- DATE S U="^",%DT="AXEP",%DT("A")="SELECT BEGINNING DATE: " D ^%DT K %DT
- G:Y<0 QUIT S ADEBDT=Y,%DT="AXEP",%DT(0)=ADEBDT,%DT("A")="SELECT ENDING DATE: " D ^%DT K %DT
- G:X="^" DATE G:Y<0 QUIT S ADEND=Y
- ASKDEV S %ZIS="Q" D ^%ZIS G QUIT:POP I $D(IO("Q")) K IO("Q") D QUE W !,"REQUEST QUEUED." G QUIT
- U IO G START^ADEXSU1
- QUE S ZTRTN="START^ADEXSU1",ZTDESC="DENTAL SERVICE DATA EXTRACT",ZTSAVE("ADEND")="",ZTSAVE("ADEBDT")="",ZTSAVE("ADEXDT")="" S:$D(ADEREX) ZTSAVE("ADEREX")="",ZTSAVE("ADEXDA")=""
- S ZTSAVE("ADECHS")=""
- S:$D(ADERERUN) ZTSAVE("ADERERUN")="",ZTSAVE("ADEXDA")=""
- D ^%ZTLOAD Q
- QUIT K ADELAST,ADELDAY,ADESTAT,ADEXDT,ADEXDA,ADEBDT,ADEND,ADEREX,ADEXNOD,ADERERUN Q
- ADEXSU0 ; IHS/HQT/MJL - DENTAL EXTRACT PART 2 ; [ 05/12/1999 5:04 PM ]
- +1 ;;6.0;ADE;**1**;MAY 12, 1999
- ADEXCK ;EP
- +1 IF '$DATA(^ADENDATA)
- GOTO OK
- +2 IF $DATA(^ADENDATA(0))
- GOTO ADEX1
- WRITE !,"The data storage area contains an incomplete file of previously extracted data."
- ADEX READ !,"Ok if I erase it? N//",X:DTIME
- IF '$TEST
- SET X=U
- SET X=$EXTRACT(X_"N")
- +1 IF X["?"
- WRITE !,"The incomplete data file was probably created during an aborted extraction",!,"attempt."
- GOTO ADEX
- +2 IF "Yy"'[X
- WRITE !," -- data extraction cancelled."
- GOTO QUIT
- +3 GOTO OK
- ADEX1 WRITE !,"Data extracted on "
- SET Y=$PIECE(^ADENDATA(0),U,3)
- IF $LENGTH(Y)=8
- SET Y=Y-17000000
- XECUTE ^DD("DD")
- WRITE Y," is still stored.",!,"It will be erased if you continue.",!
- +1 ;MJL On previous line subtracted 17 Million from CCYYMMDD formatted date to convert to FM internal date so ^DD("DD") could return a valid date
- CONFIRM READ "Ok to continue? N// ",X:DTIME
- IF '$TEST
- SET X=U
- SET X=$EXTRACT(X_"N")
- +1 IF X["?"
- WRITE !,"It is ok to clear the data extraction holding file if the data",!,"has already been forwarded to Area for processing.",!
- GOTO CONFIRM
- +2 IF "Yy"'[X
- WRITE " -- data extraction cancelled.",!
- GOTO QUIT
- OK IF $DATA(ADEREX)
- GOTO ASKDEV
- DATE SET U="^"
- SET %DT="AXEP"
- SET %DT("A")="SELECT BEGINNING DATE: "
- DO ^%DT
- KILL %DT
- +1 IF Y<0
- GOTO QUIT
- SET ADEBDT=Y
- SET %DT="AXEP"
- SET %DT(0)=ADEBDT
- SET %DT("A")="SELECT ENDING DATE: "
- DO ^%DT
- KILL %DT
- +2 IF X="^"
- GOTO DATE
- IF Y<0
- GOTO QUIT
- SET ADEND=Y
- ASKDEV SET %ZIS="Q"
- DO ^%ZIS
- IF POP
- GOTO QUIT
- IF $DATA(IO("Q"))
- KILL IO("Q")
- DO QUE
- WRITE !,"REQUEST QUEUED."
- GOTO QUIT
- +1 USE IO
- GOTO START^ADEXSU1
- QUE SET ZTRTN="START^ADEXSU1"
- SET ZTDESC="DENTAL SERVICE DATA EXTRACT"
- SET ZTSAVE("ADEND")=""
- SET ZTSAVE("ADEBDT")=""
- SET ZTSAVE("ADEXDT")=""
- IF $DATA(ADEREX)
- SET ZTSAVE("ADEREX")=""
- SET ZTSAVE("ADEXDA")=""
- +1 SET ZTSAVE("ADECHS")=""
- +2 IF $DATA(ADERERUN)
- SET ZTSAVE("ADERERUN")=""
- SET ZTSAVE("ADEXDA")=""
- +3 DO ^%ZTLOAD
- QUIT
- QUIT KILL ADELAST,ADELDAY,ADESTAT,ADEXDT,ADEXDA,ADEBDT,ADEND,ADEREX,ADEXNOD,ADERERUN
- QUIT
