ADEXER3.m

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

 ;;6.0;ADE;;APRIL 1999

 S ADEPAG=1,ADERNO=0,$P(ADELIN,"-",79)=""

 W:$P(IOST,"-")="C" @IOF D HEADER

START S ADEQIT="",ADERNO=$O(^ADERROR(ADERNO)) G:ADERNO="" END D EOP G:ADEQIT=1 END

 I $L(^ADERROR(ADERNO))>79 W !!,$E(^ADERROR(ADERNO),1,79) W !,$E(^ADERROR(ADERNO),80,$L(^ADERROR(ADERNO))) G START

 W !!,^ADERROR(ADERNO)

 G START

END W ! D ^%ZISC K ADEQIT,ADEPAG,ADELIN,ADERNO,ADERR12,ADERR13,ADEDT,ADEND,ADEOLD

 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

 K ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK

 ;K:$D(ZTSK) ^%ZTSK(ZTSK)

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

 Q

HEADER ;

 W "DENTAL SERVICE FILE ERROR LISTING",?65,"PAGE ",ADEPAG,!!,"ERROR DESCRIPTION",!,ADELIN S ADEPAG=ADEPAG+1 Q

EOP Q:$Y'>(IOSL-5)

 I $P(IOST,"-")["C" R !,X:DTIME I ('$T)!(X["^") S ADEQIT=1 Q

EOP1 W @IOF D HEADER Q

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

 +1       ;;6.0;ADE;;APRIL 1999

 +2        SET ADEPAG=1

           SET ADERNO=0

           SET $PIECE(ADELIN,"-",79)=""

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

               WRITE @IOF

           DO HEADER

START      SET ADEQIT=""

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

           IF ADERNO=""

               GOTO END

           DO EOP

           IF ADEQIT=1

               GOTO END

 +1        IF $LENGTH(^ADERROR(ADERNO))>79

               WRITE !!,$EXTRACT(^ADERROR(ADERNO),1,79)

               WRITE !,$EXTRACT(^ADERROR(ADERNO),80,$LENGTH(^ADERROR(ADERNO)))

               GOTO START

 +2        WRITE !!,^ADERROR(ADERNO)

 +3        GOTO START

END        WRITE !

           DO ^%ZISC

           KILL ADEQIT,ADEPAG,ADELIN,ADERNO,ADERR12,ADERR13,ADEDT,ADEND,ADEOLD

 +1        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

 +2        KILL ADETYPE,ADEVDTE,ADEVDTP,ADEVISDT,ADEVNODE,ADEZIP,ADEZTSK

 +3       ;K:$D(ZTSK) ^%ZTSK(ZTSK)

 +4        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +5        QUIT 

HEADER    ;

 +1        WRITE "DENTAL SERVICE FILE ERROR LISTING",?65,"PAGE ",ADEPAG,!!,"ERROR DESCRIPTION",!,ADELIN

           SET ADEPAG=ADEPAG+1

           QUIT 

EOP        IF $Y'>(IOSL-5)

               QUIT 

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

               READ !,X:DTIME

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

                   SET ADEQIT=1

                   QUIT 

EOP1       WRITE @IOF

           DO HEADER

           QUIT