ADEXER.m

ADEXER ; IHS/HQT/MJL - DENTAL ERROR REPORT PT 1 ;  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

 W !!,"Dental Service Data Error Report",!!

 D ^XBKVAR

 I '$D(^AUTTSITE(1,0)) W "RPMS SITE File not properly initialized." R !,"Press 'ENTER' to continue ",X:DTIME G QUIT

ADEXCK I '$D(^ADERROR) W !,"No error reports are on file... " G OK

 ;I '$D(^ADERROR(0)) K ^ADERROR G OK ;NON-FILEMAN WORKING GLOBAL

 I '$D(^ADERROR(0)) D KILLERR G OK ;FHL 10/19/98

ADEX1 W !!,"The error report of " S Y=$P(^ADERROR(0),U,3) X ^DD("DD") W Y," is still stored.",!,"It covered the period from " S Y=$P(^ADERROR(0),U,1) X ^DD("DD") W Y," to "

 S Y=$P(^ADERROR(0),U,2) X ^DD("DD") W Y,".",!,"Do you want to print it out? N//" R X:DTIME S:'$T X=U S X=$E(X_"N")

 I X["?" W !!,"Answer 'Y' if you want to print out the report,",!,"Answer 'N' if you want to erase the old report and run a new error check." G ADEX1

 I "Yy"[X S ADEOLD=1 G ASKDEV

OK ;

DATE K ADEBDT,ADEND 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

 I ADEBDT>ADEND W !,*7,"Beginning date must be before ending date." G DATE

ASKDEV S %ZIS="Q" D ^%ZIS G QUIT:POP I $D(IO("Q")) K IO("Q") D QUE W !,"REQUEST QUEUED." G QUIT

 I '$D(ADEOLD) U IO G START^ADEXER1

 U IO G ^ADEXER3

QUE I '$D(ADEOLD) S ZTRTN="START^ADEXER1",ZTDESC="DENTAL SERVICE ERROR RPT",ZTSAVE("ADEND")="",ZTSAVE("ADEBDT")="" D ^%ZTLOAD Q

 S ZTRTN="^ADEXER3",ZTDESC="DENTAL SERVICE ERROR RPT" D ^%ZTLOAD Q

QUIT K ADEBDT,ADEND,ADEOLD Q

 ;

KILLERR ; EP

 S ADESUB="" F  S ADESUB=$O(^ADERROR(ADESUB)) Q:ADESUB=""  K ^ADERROR(ADESUB)

 K ADESUB

 Q

ADEXER    ; IHS/HQT/MJL - DENTAL ERROR REPORT PT 1 ;  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

 +2        WRITE !!,"Dental Service Data Error Report",!!

 +3        DO ^XBKVAR

 +4        IF '$DATA(^AUTTSITE(1,0))

               WRITE "RPMS SITE File not properly initialized."

               READ !,"Press 'ENTER' to continue ",X:DTIME

               GOTO QUIT

ADEXCK     IF '$DATA(^ADERROR)

               WRITE !,"No error reports are on file... "

               GOTO OK

 +1       ;I '$D(^ADERROR(0)) K ^ADERROR G OK ;NON-FILEMAN WORKING GLOBAL

 +2       ;FHL 10/19/98

           IF '$DATA(^ADERROR(0))

               DO KILLERR

               GOTO OK

ADEX1      WRITE !!,"The error report of "

           SET Y=$PIECE(^ADERROR(0),U,3)

           XECUTE ^DD("DD")

           WRITE Y," is still stored.",!,"It covered the period from "

           SET Y=$PIECE(^ADERROR(0),U,1)

           XECUTE ^DD("DD")

           WRITE Y," to "

 +1        SET Y=$PIECE(^ADERROR(0),U,2)

           XECUTE ^DD("DD")

           WRITE Y,".",!,"Do you want to print it out? N//"

           READ X:DTIME

           IF '$TEST

               SET X=U

           SET X=$EXTRACT(X_"N")

 +2        IF X["?"

               WRITE !!,"Answer 'Y' if you want to print out the report,",!,"Answer 'N' if you want to erase the old report and run a new error check."

               GOTO ADEX1

 +3        IF "Yy"[X

               SET ADEOLD=1

               GOTO ASKDEV

OK        ;

DATE       KILL ADEBDT,ADEND

           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

 +3        IF ADEBDT>ADEND

               WRITE !,*7,"Beginning date must be before ending date."

               GOTO DATE

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        IF '$DATA(ADEOLD)

               USE IO

               GOTO START^ADEXER1

 +2        USE IO

           GOTO ^ADEXER3

QUE        IF '$DATA(ADEOLD)

               SET ZTRTN="START^ADEXER1"

               SET ZTDESC="DENTAL SERVICE ERROR RPT"

               SET ZTSAVE("ADEND")=""

               SET ZTSAVE("ADEBDT")=""

               DO ^%ZTLOAD

               QUIT 

 +1        SET ZTRTN="^ADEXER3"

           SET ZTDESC="DENTAL SERVICE ERROR RPT"

           DO ^%ZTLOAD

           QUIT 

QUIT       KILL ADEBDT,ADEND,ADEOLD

           QUIT 

 +1       ;

KILLERR   ; EP

 +1        SET ADESUB=""

           FOR 

               SET ADESUB=$ORDER(^ADERROR(ADESUB))

               IF ADESUB=""

                   QUIT 

               KILL ^ADERROR(ADESUB)

 +2        KILL ADESUB

 +3        QUIT