- 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
