Routine: XDRDSTAT

XDRDSTAT ;SF-IRMFO/IHS/OHPRD/JCM - DISPLAY STATUS OF SEARCH;   [ 08/13/92  09:50 AM ] ;08/24/99  10:01

 ;;7.3;TOOLKIT;**23,30,42**;Apr 25, 1995

;;

START ;

 N XDRDISP

 S XDRQFLG=0,XDRDISP=1

 ;D FILE G:XDRQFLG END

 W:$D(IOF) @IOF

 F XDRICNT=0:0 S XDRICNT=$O(^VA(15.1,XDRICNT)) Q:XDRICNT'>0!(XDRQFLG)  D

 . S XDRFL=+XDRICNT

 . S XDRD(0)=^VA(15.1,XDRICNT,0)

 . S XDRD(0,0)=$P(^DIC(XDRICNT,0),U)

 . K X,Y

 . D DISP

 ;D DISP

END D EOJ

FILE ;

 W !!

 S DIC(0)="QEAZ"

 S DIC("A")="Select duplicate search file to check status for: "

 S DIC="^VA(15.1," D ^DIC K DIC,X

 I Y=-1 S XDRQFLG=1 G FILEX

 S XDRFL=+Y

 S XDRD(0)=Y(0),XDRD(0,0)=Y(0,0) K Y

 W !!

FILEX Q

ASK ;

DISP ;

 N XLABEL

 F XDRDI=.02,.03,.04,.05,.07,.08,".10" S Y=$P(XDRD(0),U,+$P(XDRDI,".",2)),C=$P(^DD(15.1,+XDRDI,0),U,2) D Y^DIQ S XDRD(+XDRDI)=Y K Y,DIQ,C

 I XDRD(.02)["RUN",+$G(^VA(15.1,XDRFL,3))>0,($$NOW^XLFDT()-^VA(15.1,XDRFL,3))>.0015 D

 . S $P(^VA(15.1,XDRFL,0),U,2)="e"

 . S XDRD(.02)="ERROR(STOP)"

 . S $P(^VA(15.1,XDRFL,0),U,10)=$P(^VA(15.1,XDRFL,0),U,10)+$$FMDIFF^XLFDT($P(^(3),U),$P(^(0),U,3),2)

 . S $P(^VA(15.1,XDRFL,3),U)=""

 K XDRDI

 S G=^DIC(XDRFL,0,"GL")_"0)",XDRD("TOT")=$P(@G,U,4) S:XDRD("TOT")<XDRD(.07)!(XDRD(.02)["COMP") XDRD("TOT")=XDRD(.07) S XDRD("%")=$S(XDRD("TOT")>0:$J((XDRD(.07)/XDRD("TOT")*100),5,1),1:0)

 S XLABEL="Date Completed"

 I XDRD(.02)["COMP" S XDRD(.03)=XDRD(.04)

 . N X,%DT,Y

 . S XLABEL="   hours:min  "

 . S XDRD(.04)=+XDRD(.1)

 . I XDRD(.02)["RUN" D

 . . S X=XDRD(.03),%DT="TS" D ^%DT

 . . S XDRD(.04)=XDRD(.04)+$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)

 . S T=XDRD(.04)\3600,XDRD(.04)=XDRD(.04)-(T*3600)

 . S XDRD(.04)=(XDRD(.04)\60)

 . I XDRD(.04)<10 S XDRD(.04)="0"_XDRD(.04)

 . S XDRD(.04)=T_":"_XDRD(.04)

 . S XDRD(.04)=$E("         ",1,(18-$L(XDRD(.04)\2)))_XDRD(.04)

 W !!!!,?28,"Duplicate ",XDRD(0,0)," Search",!!

 W "Search Type",?$S(XDRD(.1)>0:13,1:14),"Date ",$S(XDRD(.02)["COMP":"Completed",XDRD(.1)>0:"Restarted",1:"Started"),?32,"Status",?42,XLABEL,?61,"# Records Checked",!

 S $P(XDRDLINE,"-",18)=""

 W $E(XDRDLINE,1,11),?13,$E(XDRDLINE,1,14),?32,$E(XDRDLINE,1,6),?42,$E(XDRDLINE,1,14),?61,XDRDLINE,!!

 W XDRD(.05),?13,$P(XDRD(.03),":",1,2),?32,XDRD(.02),?42,$P(XDRD(.04),":",1,2),?61,XDRD(.07) W:XDRD(.07)]"" "/",XDRD("TOT")," ",XDRD("%"),"%" W !!

 W !,+$P(^VA(15.1,XDRFL,0),U,12)," Potential Duplicate pairs added to the DUPLICATE RECORD FILE (#15)",!

 K XDRDLINE

 I $D(^XTMP("XDRERR",XDRFL)) W !!,"ERROR: ",^(XDRFL),!!

 I $D(XDRDISP) D

 .W !!,"Press RETURN to continue or '^' to exit: " R X:DTIME S:'$T X=U

 .S:X=U XDRQFLG=1

 .W:$D(IOF) @IOF

EOJ ;

 K XDRD,XDRQFLG

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXDRDSTAT   2677     printed  Mar 13, 2025@21:44:19                                                                                                                                                                                                    Page 2

XDRDSTAT  ;SF-IRMFO/IHS/OHPRD/JCM - DISPLAY STATUS OF SEARCH;   [ 08/13/92  09:50 AM ] ;08/24/99  10:01

 +1       ;;7.3;TOOLKIT;**23,30,42**;Apr 25, 1995

 +2       ;;

 +3       ;

START     ;

 +1        NEW XDRDISP

 +2        SET XDRQFLG=0

           SET XDRDISP=1

 +3       ;D FILE G:XDRQFLG END

 +4        if $DATA(IOF)

               WRITE @IOF

 +5        FOR XDRICNT=0:0

               SET XDRICNT=$ORDER(^VA(15.1,XDRICNT))

               if XDRICNT'>0!(XDRQFLG)

                   QUIT

               Begin DoDot:1

 +6                SET XDRFL=+XDRICNT

 +7                SET XDRD(0)=^VA(15.1,XDRICNT,0)

 +8                SET XDRD(0,0)=$PIECE(^DIC(XDRICNT,0),U)

 +9                KILL X,Y

 +10               DO DISP

               End DoDot:1

 +11      ;D DISP

END        DO EOJ

 +1        QUIT

 +2       ;

FILE      ;

 +1        WRITE !!

 +2        SET DIC(0)="QEAZ"

 +3        SET DIC("A")="Select duplicate search file to check status for: "

 +4        SET DIC="^VA(15.1,"

           DO ^DIC

           KILL DIC,X

 +5        IF Y=-1

               SET XDRQFLG=1

               GOTO FILEX

 +6        SET XDRFL=+Y

 +7        SET XDRD(0)=Y(0)

           SET XDRD(0,0)=Y(0,0)

           KILL Y

 +8        WRITE !!

FILEX      QUIT

 +1       ;

ASK       ;

 +1        QUIT

 +2       ;

DISP      ;

 +1        NEW XLABEL

 +2        FOR XDRDI=.02,.03,.04,.05,.07,.08,".10"

               SET Y=$PIECE(XDRD(0),U,+$PIECE(XDRDI,".",2))

               SET C=$PIECE(^DD(15.1,+XDRDI,0),U,2)

               DO Y^DIQ

               SET XDRD(+XDRDI)=Y

               KILL Y,DIQ,C

 +3        IF XDRD(.02)["RUN"

               IF +$GET(^VA(15.1,XDRFL,3))>0

                   IF ($$NOW^XLFDT()-^VA(15.1,XDRFL,3))>.0015

                       Begin DoDot:1

 +4                        SET $PIECE(^VA(15.1,XDRFL,0),U,2)="e"

 +5                        SET XDRD(.02)="ERROR(STOP)"

 +6                        SET $PIECE(^VA(15.1,XDRFL,0),U,10)=$PIECE(^VA(15.1,XDRFL,0),U,10)+$$FMDIFF^XLFDT($PIECE(^(3),U),$PIECE(^(0),U,3),2)

 +7                        SET $PIECE(^VA(15.1,XDRFL,3),U)=""

                       End DoDot:1

 +8        KILL XDRDI

 +9        SET G=^DIC(XDRFL,0,"GL")_"0)"

           SET XDRD("TOT")=$PIECE(@G,U,4)

           if XDRD("TOT")<XDRD(.07)!(XDRD(.02)["COMP")

               SET XDRD("TOT")=XDRD(.07)

           SET XDRD("%")=$SELECT(XDRD("TOT")>0:$JUSTIFY((XDRD(.07)/XDRD("TOT")*100),5,1),1:0)

 +10       SET XLABEL="Date Completed"

 +11       IF XDRD(.02)["COMP"

               SET XDRD(.03)=XDRD(.04)

 +12       Begin DoDot:1

 +13           NEW X,%DT,Y

 +14           SET XLABEL="   hours:min  "

 +15           SET XDRD(.04)=+XDRD(.1)

 +16           IF XDRD(.02)["RUN"

                   Begin DoDot:2

 +17                   SET X=XDRD(.03)

                       SET %DT="TS"

                       DO ^%DT

 +18                   SET XDRD(.04)=XDRD(.04)+$$FMDIFF^XLFDT($$NOW^XLFDT(),Y,2)

                   End DoDot:2

 +19           SET T=XDRD(.04)\3600

               SET XDRD(.04)=XDRD(.04)-(T*3600)

 +20           SET XDRD(.04)=(XDRD(.04)\60)

 +21           IF XDRD(.04)<10

                   SET XDRD(.04)="0"_XDRD(.04)

 +22           SET XDRD(.04)=T_":"_XDRD(.04)

 +23           SET XDRD(.04)=$EXTRACT("         ",1,(18-$LENGTH(XDRD(.04)\2)))_XDRD(.04)

           End DoDot:1

 +24       WRITE !!!!,?28,"Duplicate ",XDRD(0,0)," Search",!!

 +25       WRITE "Search Type",?$SELECT(XDRD(.1)>0:13,1:14),"Date ",$SELECT(XDRD(.02)["COMP":"Completed",XDRD(.1)>0:"Restarted",1:"Started"),?32,"Status",?42,XLABEL,?61,"# Records Checked",!

 +26       SET $PIECE(XDRDLINE,"-",18)=""

 +27       WRITE $EXTRACT(XDRDLINE,1,11),?13,$EXTRACT(XDRDLINE,1,14),?32,$EXTRACT(XDRDLINE,1,6),?42,$EXTRACT(XDRDLINE,1,14),?61,XDRDLINE,!!

 +28       WRITE XDRD(.05),?13,$PIECE(XDRD(.03),":",1,2),?32,XDRD(.02),?42,$PIECE(XDRD(.04),":",1,2),?61,XDRD(.07)

           if XDRD(.07)]""

               WRITE "/",XDRD("TOT")," ",XDRD("%"),"%"

           WRITE !!

 +29       WRITE !,+$PIECE(^VA(15.1,XDRFL,0),U,12)," Potential Duplicate pairs added to the DUPLICATE RECORD FILE (#15)",!

 +30       KILL XDRDLINE

 +31       IF $DATA(^XTMP("XDRERR",XDRFL))

               WRITE !!,"ERROR: ",^(XDRFL),!!

 +32       IF $DATA(XDRDISP)

               Begin DoDot:1

 +33               WRITE !!,"Press RETURN to continue or '^' to exit: "

                   READ X:DTIME

                   if '$TEST

                       SET X=U

 +34               if X=U

                       SET XDRQFLG=1

 +35               if $DATA(IOF)

                       WRITE @IOF

               End DoDot:1

 +36       QUIT

 +37      ;

EOJ       ;

 +1        KILL XDRD,XDRQFLG

 +2        QUIT

XDRDSTAT.m