- DIAXP ;SFISC/DCM-EXCEPTION REPORT ;5/16/96 10:56
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;
- N PAGE,LINE,DIAXX,FILE,FNAME,Y,DATE,DIRUT,Z
- S PAGE=0,LINE="",DIAXX=^DIAR(1.11,DIARC,0),FILE=$P(DIAXX,U,2),FNAME=$P($G(^DIC(FILE,0)),U)
- S Y=DT X ^DD("DD") S DATE=Y
- D HDR,BODY,END
- Q
- ;
- C I IOST["C-" N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
- ;
- HDR W:$Y @IOF W !,"EXTRACT ACTIVITY EXCEPTION REPORT",?IOM-24,DATE,?IOM-10,"PAGE: ",PAGE+1
- S PAGE=PAGE+1,$P(LINE,"-",IOM)="" W !,LINE
- Q
- ;
- BODY W !!,"EXTRACT ACTIVITY: ",DIARC,?31,"ARCHIVER: ",$P($G(^VA(200,$P(DIAXX,U,6),0)),U)
- W !!,"THE FOLLOWING RECORDS IN THE '"_FNAME_"' FILE WERE NOT PROCESSED BY THE",!,"EXTRACT TOOL"
- N REC,LINE,ERR S REC=0 D REC Q:$D(DIRUT)
- W !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
- Q
- REC S LINE="Entry # "
- S REC=$O(^TMP("DIAXU",$J,"RESULT","ERR",FILE,REC)) Q:'REC S ERR=^(REC)
- S LINE=LINE_+REC_" was NOT processed because:"
- D C:($Y+3>IOSL) Q:$D(DIRUT)
- W !!,LINE N A,B S A=1 D ERR
- G REC
- ERR S B=$P(ERR,";",A) Q:B="" S A=A+1
- N Z S Z=0
- F S Z=$O(^TMP("DIERR",$J,+B,"TEXT",Z)) Q:'Z D C:($Y+1>IOSL) Q:$D(DIRUT) W !?2,$G(^(Z))
- G ERR
- ;
- END I $E(IOST)'="C",$Y W @IOF
- D ^%ZISC
- K ^TMP("DIAXU",$J),^TMP("DIERR",$J)
- Q
- DIAXP ;SFISC/DCM-EXCEPTION REPORT ;5/16/96 10:56
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;
- +1 NEW PAGE,LINE,DIAXX,FILE,FNAME,Y,DATE,DIRUT,Z
- +2 SET PAGE=0
- SET LINE=""
- SET DIAXX=^DIAR(1.11,DIARC,0)
- SET FILE=$PIECE(DIAXX,U,2)
- SET FNAME=$PIECE($GET(^DIC(FILE,0)),U)
- +3 SET Y=DT
- XECUTE ^DD("DD")
- SET DATE=Y
- +4 DO HDR
- DO BODY
- DO END
- +5 QUIT
- +6 ;
- C IF IOST["C-"
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DIRUT)
- QUIT
- +1 ;
- HDR IF $Y
- WRITE @IOF
- WRITE !,"EXTRACT ACTIVITY EXCEPTION REPORT",?IOM-24,DATE,?IOM-10,"PAGE: ",PAGE+1
- +1 SET PAGE=PAGE+1
- SET $PIECE(LINE,"-",IOM)=""
- WRITE !,LINE
- +2 QUIT
- +3 ;
- BODY WRITE !!,"EXTRACT ACTIVITY: ",DIARC,?31,"ARCHIVER: ",$PIECE($GET(^VA(200,$PIECE(DIAXX,U,6),0)),U)
- +1 WRITE !!,"THE FOLLOWING RECORDS IN THE '"_FNAME_"' FILE WERE NOT PROCESSED BY THE",!,"EXTRACT TOOL"
- +2 NEW REC,LINE,ERR
- SET REC=0
- DO REC
- IF $DATA(DIRUT)
- QUIT
- +3 WRITE !!,"*** PLEASE KEEP THIS FOR FUTURE REFERENCE ***"
- +4 QUIT
- REC SET LINE="Entry # "
- +1 SET REC=$ORDER(^TMP("DIAXU",$JOB,"RESULT","ERR",FILE,REC))
- IF 'REC
- QUIT
- SET ERR=^(REC)
- +2 SET LINE=LINE_+REC_" was NOT processed because:"
- +3 IF ($Y+3>IOSL)
- DO C
- IF $DATA(DIRUT)
- QUIT
- +4 WRITE !!,LINE
- NEW A,B
- SET A=1
- DO ERR
- +5 GOTO REC
- ERR SET B=$PIECE(ERR,";",A)
- IF B=""
- QUIT
- SET A=A+1
- +1 NEW Z
- SET Z=0
- +2 FOR
- SET Z=$ORDER(^TMP("DIERR",$JOB,+B,"TEXT",Z))
- IF 'Z
- QUIT
- IF ($Y+1>IOSL)
- DO C
- IF $DATA(DIRUT)
- QUIT
- WRITE !?2,$GET(^(Z))
- +3 GOTO ERR
- +4 ;
- END IF $EXTRACT(IOST)'="C"
- IF $Y
- WRITE @IOF
- +1 DO ^%ZISC
- +2 KILL ^TMP("DIAXU",$JOB),^TMP("DIERR",$JOB)
- +3 QUIT
