ADEXER1.m

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

 ;;6.0;ADE;;APRIL 1999

START ;EP

 S ADEBS6="",$P(ADEBS6,$C(8),7)="",(ADEDF,ADERC)=0,ADERNO=1

 U IO

 S:($P(IOST,"-",1)'="C") ADEBS6=" "

 W !!!,?12,"E R R O R   S E A R C H   B E G U N",!

 ;K ^ADERROR ; NON-FILEMAN, WORKING GLOBAL

 D KILLERR^ADEXER ;FHL 10/19/98

 D CHKY1

 I ADERNO>1 S ^ADERROR(0)=ADEBDT_U_ADEND_U_DT_U_ADERC_U_(ADERNO-1)

FIN W !,?15,"RECORDS PROCESSED: ",ADERC,!

 W !,?15,"TOTAL ERRORS: ",ADERNO-1,!

 W !,?12,"P R O C E S S I N G   C O M P L E T E D",!!

 I ADERNO'>1 G EXIT

 I $P(IOST,"-")["C" R "Press 'ENTER' to see Error List ( '^' to Quit): ",X:DTIME G:('$T)!(X["^") EXIT W:$D(IOF) @IOF G ^ADEXER3

 W:$D(IOF) @IOF G ^ADEXER3

EXIT D ^%ZISC ;U 0

 I $D(ZTQUEUED) S ZTREQ="@"

 K ADEA,ADEADACP,ADEADAF,ADEADAQ,ADEASF,ADEASITE,ADEB,ADEBDT,ADEBS6,ADEC,ADED,ADEDF,ADEDFN,ADEDMFLG,ADEDOB,ADEEDT,ADEERR,ADEFN,ADEFNO,ADEHRN,ADEIDX,ADENAT,ADENODE,ADERC,ADERDV,ADEREPD,ADESERV,ADESEX,ADESITE,ADESUFAC,ADESVCS,ADETCOST

QUIT K ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK,ADEDT,ADEND,ADERR,ADERNO,ADEOLD

 Q

CHKY1 ;GET FIRST DATE FROM "AC" XREF

 W !,?15,"RECORD SCANNING "

 S ADEDT=ADEBDT-1 F ADEIDX=0:0 S ADEDT=$O(^ADEPCD("AC",ADEDT)) Q:(ADEDT="")!(ADEDT>ADEND)  W "." D CHKY2

 W "COMPLETED",!

 Q

CHKY2 S ADEA=0 F ADEIDX=0:0 S ADEA=$O(^ADEPCD("AC",ADEDT,ADEA)) Q:'+ADEA  D CHKY3

 Q

CHKY3 I '$D(^ADEPCD(ADEA,0)) G ERR1^ADEXER2

 Q:$P(^ADEPCD(ADEA,0),U,6)

 I $P(^ADEPCD(ADEA,0),U,3)']"" G ERR3^ADEXER2

 I '$D(^ADEPCD(ADEA,"ADA",0)) G ERR10^ADEXER2

 I $O(^ADEPCD(ADEA,"ADA",0))="" G ERR10^ADEXER2

 S ADEVNODE=^ADEPCD(ADEA,0)

 S ADEVDTE="",ADEVDTP=""

 S ADEDFN=$P(ADEVNODE,U)

 G:'$D(^DPT(ADEDFN,0)) ERR4^ADEXER2

 ;G:'$D(^DPT(ADEDFN,11)) ERR7^ADEXER2

 ;G:$P(^DPT(ADEDFN,11),U,11)="" ERR7^ADEXER2

 S ADEVDTE=$E($P(ADEVNODE,U,2),2,7)

 I ADEVDTE="" G ERR5^ADEXER2

 S ADEREPD=$P(ADEVNODE,U,4)

 I ADEREPD="" G ERR6^ADEXER2

 I '$D(^DIC(16,ADEREPD,0)) G ERR6^ADEXER2

 I $P(^DIC(16,ADEREPD,0),U,9)="" G ERR12^ADEXER2

 S ADERC=ADERC+1

 Q

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

 +1       ;;6.0;ADE;;APRIL 1999

START     ;EP

 +1        SET ADEBS6=""

           SET $PIECE(ADEBS6,$CHAR(8),7)=""

           SET (ADEDF,ADERC)=0

           SET ADERNO=1

 +2        USE IO

 +3        IF ($PIECE(IOST,"-",1)'="C")

               SET ADEBS6=" "

 +4        WRITE !!!,?12,"E R R O R   S E A R C H   B E G U N",!

 +5       ;K ^ADERROR ; NON-FILEMAN, WORKING GLOBAL

 +6       ;FHL 10/19/98

           DO KILLERR^ADEXER

 +7        DO CHKY1

 +8        IF ADERNO>1

               SET ^ADERROR(0)=ADEBDT_U_ADEND_U_DT_U_ADERC_U_(ADERNO-1)

FIN        WRITE !,?15,"RECORDS PROCESSED: ",ADERC,!

 +1        WRITE !,?15,"TOTAL ERRORS: ",ADERNO-1,!

 +2        WRITE !,?12,"P R O C E S S I N G   C O M P L E T E D",!!

 +3        IF ADERNO'>1

               GOTO EXIT

 +4        IF $PIECE(IOST,"-")["C"

               READ "Press 'ENTER' to see Error List ( '^' to Quit): ",X:DTIME

               IF ('$TEST)!(X["^")

                   GOTO EXIT

               IF $DATA(IOF)

                   WRITE @IOF

               GOTO ^ADEXER3

 +5        IF $DATA(IOF)

               WRITE @IOF

           GOTO ^ADEXER3

EXIT      ;U 0

           DO ^%ZISC

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        KILL ADEA,ADEADACP,ADEADAF,ADEADAQ,ADEASF,ADEASITE,ADEB,ADEBDT,ADEBS6,ADEC,ADED,ADEDF,ADEDFN,ADEDMFLG,ADEDOB,ADEEDT,ADEERR,ADEFN,ADEFNO,ADEHRN,ADEIDX,ADENAT,ADENODE,ADERC,ADERDV,ADEREPD,ADESERV,ADESEX,ADESITE,ADESUFAC,ADESVCS,ADETCOST

QUIT       KILL ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK,ADEDT,ADEND,ADERR,ADERNO,ADEOLD

 +1        QUIT 

CHKY1     ;GET FIRST DATE FROM "AC" XREF

 +1        WRITE !,?15,"RECORD SCANNING "

 +2        SET ADEDT=ADEBDT-1

           FOR ADEIDX=0:0

               SET ADEDT=$ORDER(^ADEPCD("AC",ADEDT))

               IF (ADEDT="")!(ADEDT>ADEND)

                   QUIT 

               WRITE "."

               DO CHKY2

 +3        WRITE "COMPLETED",!

 +4        QUIT 

CHKY2      SET ADEA=0

           FOR ADEIDX=0:0

               SET ADEA=$ORDER(^ADEPCD("AC",ADEDT,ADEA))

               IF '+ADEA

                   QUIT 

               DO CHKY3

 +1        QUIT 

CHKY3      IF '$DATA(^ADEPCD(ADEA,0))

               GOTO ERR1^ADEXER2

 +1        IF $PIECE(^ADEPCD(ADEA,0),U,6)

               QUIT 

 +2        IF $PIECE(^ADEPCD(ADEA,0),U,3)']""

               GOTO ERR3^ADEXER2

 +3        IF '$DATA(^ADEPCD(ADEA,"ADA",0))

               GOTO ERR10^ADEXER2

 +4        IF $ORDER(^ADEPCD(ADEA,"ADA",0))=""

               GOTO ERR10^ADEXER2

 +5        SET ADEVNODE=^ADEPCD(ADEA,0)

 +6        SET ADEVDTE=""

           SET ADEVDTP=""

 +7        SET ADEDFN=$PIECE(ADEVNODE,U)

 +8        IF '$DATA(^DPT(ADEDFN,0))

               GOTO ERR4^ADEXER2

 +9       ;G:'$D(^DPT(ADEDFN,11)) ERR7^ADEXER2

 +10      ;G:$P(^DPT(ADEDFN,11),U,11)="" ERR7^ADEXER2

 +11       SET ADEVDTE=$EXTRACT($PIECE(ADEVNODE,U,2),2,7)

 +12       IF ADEVDTE=""

               GOTO ERR5^ADEXER2

 +13       SET ADEREPD=$PIECE(ADEVNODE,U,4)

 +14       IF ADEREPD=""

               GOTO ERR6^ADEXER2

 +15       IF '$DATA(^DIC(16,ADEREPD,0))

               GOTO ERR6^ADEXER2

 +16       IF $PIECE(^DIC(16,ADEREPD,0),U,9)=""

               GOTO ERR12^ADEXER2

 +17       SET ADERC=ADERC+1

 +18       QUIT