- 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
