BLRRFILE ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG ; [ 07/30/2002 8:45 AM ]
;;5.2;LR;**1013**;JUL 30, 2002
CTL ;
D INIT
D SEQ1 Q:BLRDONE
D:'BLRDONE TEMP
D KILL
Q
;
INIT ;
S BLR="",BLRPCC=$G(BLRPCC) I BLRPCC'="" S BLRHDR="WITH PCC ERRORS" S:BLRPCC'="ALL" BLRHDR=BLRHDR_" CONTAINING "_BLRPCC
I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
Q
;
ASKSEQS ;
S DIC("A")="START WITH SEQUENCE NUMBER: ",DIC("B")=1 D ASKSEQ Q:'BLRDONE S BLRFIRST=+Y
ASKSEQS1 S DIC("A")="GO TO SEQUENCE NUMBER: ",DIC("B")=$P(^BLRTXLOG(0),U,3)
D ASKSEQ Q:'BLRDONE
I Y<BLRFIRST W "LAST must be greater than START !" G ASKSEQS1
S BLRLAST=+Y
Q
;
SEQ ;
D SEQ1,KILL
Q
;
SEQ1 ;
D ASKSEQ Q:'BLRDONE
S BLRLOGDA=+Y D SHOW
Q
;
ASKSEQ ;
S BLRDONE=0
S DIC=9009022,DIC(0)="AQEM" D ^DIC Q:Y<1
S BLRDONE=1
Q
;
SHOW K DA,DR S DA=BLRLOGDA D EN^DIQ
W !!,"Do you wish to try and refile this entry?",!
S DIR(0)="Y",DIR("A")="Enter Yes or No",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) W !,"Entry NOT filed",! Q
I +Y=0 W !,"Entry NOT filed",! Q
D TOP^BLRQUE(BLRLOGDA,0)
Q
;
SORT ;
D INIT,TEMP,KILL
Q
;
PCCERR ;
S BLRGLO="^TMP($J)"
D INIT,ASKSEQS I BLRDONE D CHECK D ASKQUE:BLRFND
D KILL
K ^TMP($J)
Q
;
TEMP ;
; Ask for template
;
S BLRGLO="^DIBT(BLRTMP,1)",DIC=.401,DIC(0)="AQEMZ" D ^DIC Q:Y<1
I $P(Y(0),U,4)'=9009022 W !!,"Template must read IHS Lab Transaction Log! (File #9009022)",! G TEMP
S BLRTMP=+Y
D ASKQUE
Q
;
CHECK ;
S BLRFND=0,BLRN=$S($G(BLRFIRST):BLRFIRST-1,1:0)
F S BLRN=$O(^BLRTXLOG(BLRN)) Q:$S('BLRN:1,BLRLAST:BLRN>BLRLAST) D
.S BLRERR=$P($G(^BLRTXLOG(BLRN,1)),U,6)
.I BLRPCC="ALL" S:BLRERR'="" BLRFND=1,^TMP($J,BLRN)="" Q
.S:BLRERR[BLRPCC BLRFND=1,^TMP($J,BLRN)=""
W:'BLRFND !,"No Matches found",!
Q
;
ASKQUE ;
D HDR
S BLRN=0 F S BLRN=$O(@BLRGLO@(BLRN)) Q:'BLRN W BLRN,?$X+10\10*10 I $X>70 W ! I $Y#20=0 W !,"Press enter to continue: " R BLR:10,! Q:BLR="^" D HDR
I BLR="^" W "request aborted",! Q
W !!,"Do you wish to Queue these entries for processing?",!
S DIR(0)="Y",DIR("A")="Enter Yes or No",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I +Y=0 W !,"Entries NOT Queued",! Q
S BLRN=0 F S BLRN=$O(@BLRGLO@(BLRN)) Q:'BLRN D TOP^BLRQUE(BLRN)
Q
;
HDR ;
W @IOF,!,?22,"IHS LAB Transaction Sequence Numbers",! W:BLRPCC'="" ?(80-$L(BLRHDR))/2,BLRHDR,! W !
Q
;
START ;STARTS LOOP FOR REFILING
S BLRX=0 F S BLRX=$O(^BLRTXLOG(BLRX)) Q:+BLRX=0 D ONE Q:$G(DUOUT)
W !,"FINISHED",!! Q
;
ONE S BLRY=$G(^BLRTXLOG(BLRX,1))
Q:$P(BLRY,U,6)=""
S BLRLOGDA=BLRX,DIC="^BLRTXLOG(" D SHOW
S BLRY=$G(^BLRTXLOG(BLRX,1))
W:$L($P(BLRY,U,6)) !!,"ERROR** "_$P(BLRY,U,6)_" **REPORTED",*7,!!
Q
;
KILL ;
K BLR,BLRDONE,BLRERR,BLRGLO,BLRHDR,BLRLOGDA,BLRN,BLRPCC,BLRTMP,BLRX,BLRY,DA,DIC,DIR,DIRUT
Q
BLRRFILE ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG ; [ 07/30/2002 8:45 AM ]
+1 ;;5.2;LR;**1013**;JUL 30, 2002
CTL ;
+1 DO INIT
+2 DO SEQ1
IF BLRDONE
QUIT
+3 IF 'BLRDONE
DO TEMP
+4 DO KILL
+5 QUIT
+6 ;
INIT ;
+1 SET BLR=""
SET BLRPCC=$GET(BLRPCC)
IF BLRPCC'=""
SET BLRHDR="WITH PCC ERRORS"
IF BLRPCC'="ALL"
SET BLRHDR=BLRHDR_" CONTAINING "_BLRPCC
+2 IF '$DATA(IOF)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+3 QUIT
+4 ;
ASKSEQS ;
+1 SET DIC("A")="START WITH SEQUENCE NUMBER: "
SET DIC("B")=1
DO ASKSEQ
IF 'BLRDONE
QUIT
SET BLRFIRST=+Y
ASKSEQS1 SET DIC("A")="GO TO SEQUENCE NUMBER: "
SET DIC("B")=$PIECE(^BLRTXLOG(0),U,3)
+1 DO ASKSEQ
IF 'BLRDONE
QUIT
+2 IF Y<BLRFIRST
WRITE "LAST must be greater than START !"
GOTO ASKSEQS1
+3 SET BLRLAST=+Y
+4 QUIT
+5 ;
SEQ ;
+1 DO SEQ1
DO KILL
+2 QUIT
+3 ;
SEQ1 ;
+1 DO ASKSEQ
IF 'BLRDONE
QUIT
+2 SET BLRLOGDA=+Y
DO SHOW
+3 QUIT
+4 ;
ASKSEQ ;
+1 SET BLRDONE=0
+2 SET DIC=9009022
SET DIC(0)="AQEM"
DO ^DIC
IF Y<1
QUIT
+3 SET BLRDONE=1
+4 QUIT
+5 ;
SHOW KILL DA,DR
SET DA=BLRLOGDA
DO EN^DIQ
+1 WRITE !!,"Do you wish to try and refile this entry?",!
+2 SET DIR(0)="Y"
SET DIR("A")="Enter Yes or No"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
WRITE !,"Entry NOT filed",!
QUIT
+4 IF +Y=0
WRITE !,"Entry NOT filed",!
QUIT
+5 DO TOP^BLRQUE(BLRLOGDA,0)
+6 QUIT
+7 ;
SORT ;
+1 DO INIT
DO TEMP
DO KILL
+2 QUIT
+3 ;
PCCERR ;
+1 SET BLRGLO="^TMP($J)"
+2 DO INIT
DO ASKSEQS
IF BLRDONE
DO CHECK
IF BLRFND
DO ASKQUE
+3 DO KILL
+4 KILL ^TMP($JOB)
+5 QUIT
+6 ;
TEMP ;
+1 ; Ask for template
+2 ;
+3 SET BLRGLO="^DIBT(BLRTMP,1)"
SET DIC=.401
SET DIC(0)="AQEMZ"
DO ^DIC
IF Y<1
QUIT
+4 IF $PIECE(Y(0),U,4)'=9009022
WRITE !!,"Template must read IHS Lab Transaction Log! (File #9009022)",!
GOTO TEMP
+5 SET BLRTMP=+Y
+6 DO ASKQUE
+7 QUIT
+8 ;
CHECK ;
+1 SET BLRFND=0
SET BLRN=$SELECT($GET(BLRFIRST):BLRFIRST-1,1:0)
+2 FOR
SET BLRN=$ORDER(^BLRTXLOG(BLRN))
IF $SELECT('BLRN
QUIT
Begin DoDot:1
+3 SET BLRERR=$PIECE($GET(^BLRTXLOG(BLRN,1)),U,6)
+4 IF BLRPCC="ALL"
IF BLRERR'=""
SET BLRFND=1
SET ^TMP($JOB,BLRN)=""
QUIT
+5 IF BLRERR[BLRPCC
SET BLRFND=1
SET ^TMP($JOB,BLRN)=""
End DoDot:1
+6 IF 'BLRFND
WRITE !,"No Matches found",!
+7 QUIT
+8 ;
ASKQUE ;
+1 DO HDR
+2 SET BLRN=0
FOR
SET BLRN=$ORDER(@BLRGLO@(BLRN))
IF 'BLRN
QUIT
WRITE BLRN,?$X+10\10*10
IF $X>70
WRITE !
IF $Y#20=0
WRITE !,"Press enter to continue: "
READ BLR:10,!
IF BLR="^"
QUIT
DO HDR
+3 IF BLR="^"
WRITE "request aborted",!
QUIT
+4 WRITE !!,"Do you wish to Queue these entries for processing?",!
+5 SET DIR(0)="Y"
SET DIR("A")="Enter Yes or No"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF +Y=0
WRITE !,"Entries NOT Queued",!
QUIT
+7 SET BLRN=0
FOR
SET BLRN=$ORDER(@BLRGLO@(BLRN))
IF 'BLRN
QUIT
DO TOP^BLRQUE(BLRN)
+8 QUIT
+9 ;
HDR ;
+1 WRITE @IOF,!,?22,"IHS LAB Transaction Sequence Numbers",!
IF BLRPCC'=""
WRITE ?(80-$LENGTH(BLRHDR))/2,BLRHDR,!
WRITE !
+2 QUIT
+3 ;
START ;STARTS LOOP FOR REFILING
+1 SET BLRX=0
FOR
SET BLRX=$ORDER(^BLRTXLOG(BLRX))
IF +BLRX=0
QUIT
DO ONE
IF $GET(DUOUT)
QUIT
+2 WRITE !,"FINISHED",!!
QUIT
+3 ;
ONE SET BLRY=$GET(^BLRTXLOG(BLRX,1))
+1 IF $PIECE(BLRY,U,6)=""
QUIT
+2 SET BLRLOGDA=BLRX
SET DIC="^BLRTXLOG("
DO SHOW
+3 SET BLRY=$GET(^BLRTXLOG(BLRX,1))
+4 IF $LENGTH($PIECE(BLRY,U,6))
WRITE !!,"ERROR** "_$PIECE(BLRY,U,6)_" **REPORTED",*7,!!
+5 QUIT
+6 ;
KILL ;
+1 KILL BLR,BLRDONE,BLRERR,BLRGLO,BLRHDR,BLRLOGDA,BLRN,BLRPCC,BLRTMP,BLRX,BLRY,DA,DIC,DIR,DIRUT
+2 QUIT
