XDRCNT.m

XDRCNT ;SF-IRMFO/OHPRD/LAB - Count/Tally records by status/merged status;   [ 08/13/92  09:50 AM ] ;8/28/08  17:55

 ;;7.3;TOOLKIT;**23,113**;Apr 25, 1995;Build 9

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 ;;

START ;

 D EN^XDRVCHEK

 D INFORM

 D INIT

 D GETFILE

 G:XDRQFLG EOJ

 D ZIS

 G:XDRQFLG EOJ

 D PROCESS

 D EOJ

 Q

EOJ ;Eoj cleanup

 K XDRQFLG,XDRD,XDRFL,XDRCNT

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

 K ZTSK,POP,I,S

 W:$D(IOF) @IOF

 D ^%ZISC

 Q

INIT ;initialize variables

 S XDRQFLG=0,XDRCNT("PG")=0

 S X=$G(^DD(15,.03,0)) I X="" W !!,$C(7),"Dictionary error!!  Notify a programmer!" S XDRQFLG=1 Q

 S X=$P(X,U,3)

 F I=1:1 S S=$P(X,";",I) Q:S=""  S XDRCNT("STATUS",$P(S,":",1),"CNT")=0,XDRCNT("STATUS",$P(S,":",1),"NAME")=$P(S,":",2)

 I '$D(XDRCNT("STATUS")) S XDRQFLG=1 W !!,"Dictionary error!!  Notify a programmer!" Q

 S X=$G(^DD(15,.05,0)) I X="" W !!,$C(7),"Dictionary error!!  Notify a programmer!" S XDRQFLG=1 Q

 S X=$P(X,U,3)

 F I=1:1 S S=$P(X,";",I) Q:S=""  S XDRCNT("MERGE STATUS",$P(S,":",1),"CNT")=0,XDRCNT("MERGE STATUS",$P(S,":",1),"NAME")=$P(S,":",2)

 I '$D(XDRCNT("MERGE STATUS")) S XDRQFLG=1 W !!,"Dictionary error!!  Notify a programmer!" Q

 S XDRCNT("TOTAL RECS")=0

 Q

 ;

GETFILE ;get file to tally records fo

 K XDRFL

 ; XT*7.3*113 input variable XDRNOPT to FILE^XDRDQUE-if UNDEF, allows PATIENT file to be selected

 N XDRNOPT

 S DIC("A")="Tally duplicate entries for which file? " D FILE^XDRDQUE

 Q:XDRQFLG

 S XDRCNT("GBL")=^DIC(XDRFL,0,"GL"),XDRCNT("GBL")=$P(XDRCNT("GBL"),U,2)

 Q

ZIS W !! K ZTSK,ZTQUEUED,IOP S %ZIS="PQM" D ^%ZIS

 I POP S XDRQFLG=1 Q

 I $D(IO("Q")) D TSKMN

 Q

TSKMN ;

 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST

 I $D(IO("DOC")),IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC")

 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL

 K ZTSAVE S ZTSAVE("*")=""

 S ZTRTN="PROCESS^XDRCNT",ZTDTH="",ZTDESC="TALLY DUPLICATE RECORD STATUS" D ^%ZTLOAD S XDRQFLG=1

 Q

PROCESS ;

 NEW X,D,S

 ;S X=0_";"_XDRCNT("GBL") F  S X=$O(^VA(15,"B",X)) Q:X=""!($P(X,";",2)'=XDRCNT("GBL"))  D

 S X=0_";"_XDRCNT("GBL") F  S X=$O(^VA(15,"B",X)) Q:X=""  I $P(X,";",2)=XDRCNT("GBL") D

 . S D=0 F  S D=$O(^VA(15,"B",X,D)) Q:D'=+D   D

 . . Q:^VA(15,"B",X,D)=1

 . . S XDRCNT("TOTAL RECS")=XDRCNT("TOTAL RECS")+1

 . . S S=$P(^VA(15,D,0),U,3)

 . . I S=""

 . . E  S XDRCNT("STATUS",S,"CNT")=$G(XDRCNT("STATUS",S,"CNT"))+1

 . . I S="V" D

 . . . S S=+$P(^VA(15,D,0),U,5)

 . . . S XDRCNT("MERGE STATUS",S,"CNT")=XDRCNT("MERGE STATUS",S,"CNT")+1

 . . Q

 .Q

PRINT ;print report

 U IO

 D HEADER

 W !!,"Total Number of Duplicate Records for File ",$E(XDRD(0,0),1,18),":  ",?65,$J(XDRCNT("TOTAL RECS"),6),!

 W !?5,"STATUS field:" S X=0 F  S X=$O(XDRCNT("STATUS",X)) Q:X=""  D

 .I $Y>(IOSL-5) D HEADER Q:$D(XDRCNT("QUIT"))  W !

 .W ?26,$E(XDRCNT("STATUS",X,"NAME"),1,34),?65,$J(XDRCNT("STATUS",X,"CNT"),6),!

 W !?5,"MERGE STATUS field:" S X="" F  S X=$O(XDRCNT("MERGE STATUS",X)) Q:X=""  D

 .I $Y>(IOSL-5) D HEADER Q:$D(XDRCNT("QUIT"))  W !

 .W ?26,$E(XDRCNT("MERGE STATUS",X,"NAME"),1,34),?65,$J(XDRCNT("MERGE STATUS",X,"CNT"),6),!

 .Q

 I $E(IOST)="C" W !!,"End of Report.  Press return to exit" R X:DTIME

 Q

HEADER ;print header information

 N DIR,X,Y

 I 'XDRCNT("PG") G HEADER1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S XDRCNT("QUIT")="" Q

HEADER1 ;

 W:$D(IOF) @IOF S XDRCNT("PG")=XDRCNT("PG")+1

 W !?3,$P(^DIC(4,DUZ(2),0),U) S Y=DT D DD^%DT W ?50,Y,?70,"Page ",XDRCNT("PG"),?78,!

 W !?12,"TALLY OF DUPLICATE RECORDS' STATUS/MERGE STATUS FIELDS"

 S XDRCNT("LENG")=7+$L(XDRD(0,0))

 W !?((80-XDRCNT("LENG"))/2),"FILE:  ",XDRD(0,0),?78,!

 W !,$TR($J("",80)," ","-")

 Q

INFORM ;inform user

 W !!,"This report will tally the Status and Merge Status fields for all",!,"entries in the Duplicate record file for the file that you select.",!

 Q

XDRCNT    ;SF-IRMFO/OHPRD/LAB - Count/Tally records by status/merged status;   [ 08/13/92  09:50 AM ] ;8/28/08  17:55

 +1       ;;7.3;TOOLKIT;**23,113**;Apr 25, 1995;Build 9

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;;

START     ;

 +1        DO EN^XDRVCHEK

 +2        DO INFORM

 +3        DO INIT

 +4        DO GETFILE

 +5        IF XDRQFLG

               GOTO EOJ

 +6        DO ZIS

 +7        IF XDRQFLG

               GOTO EOJ

 +8        DO PROCESS

 +9        DO EOJ

 +10       QUIT 

EOJ       ;Eoj cleanup

 +1        KILL XDRQFLG,XDRD,XDRFL,XDRCNT

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        KILL ZTSK,POP,I,S

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        DO ^%ZISC

 +6        QUIT 

INIT      ;initialize variables

 +1        SET XDRQFLG=0

           SET XDRCNT("PG")=0

 +2        SET X=$GET(^DD(15,.03,0))

           IF X=""

               WRITE !!,$CHAR(7),"Dictionary error!!  Notify a programmer!"

               SET XDRQFLG=1

               QUIT 

 +3        SET X=$PIECE(X,U,3)

 +4        FOR I=1:1

               SET S=$PIECE(X,";",I)

               IF S=""

                   QUIT 

               SET XDRCNT("STATUS",$PIECE(S,":",1),"CNT")=0

               SET XDRCNT("STATUS",$PIECE(S,":",1),"NAME")=$PIECE(S,":",2)

 +5        IF '$DATA(XDRCNT("STATUS"))

               SET XDRQFLG=1

               WRITE !!,"Dictionary error!!  Notify a programmer!"

               QUIT 

 +6        SET X=$GET(^DD(15,.05,0))

           IF X=""

               WRITE !!,$CHAR(7),"Dictionary error!!  Notify a programmer!"

               SET XDRQFLG=1

               QUIT 

 +7        SET X=$PIECE(X,U,3)

 +8        FOR I=1:1

               SET S=$PIECE(X,";",I)

               IF S=""

                   QUIT 

               SET XDRCNT("MERGE STATUS",$PIECE(S,":",1),"CNT")=0

               SET XDRCNT("MERGE STATUS",$PIECE(S,":",1),"NAME")=$PIECE(S,":",2)

 +9        IF '$DATA(XDRCNT("MERGE STATUS"))

               SET XDRQFLG=1

               WRITE !!,"Dictionary error!!  Notify a programmer!"

               QUIT 

 +10       SET XDRCNT("TOTAL RECS")=0

 +11       QUIT 

 +12      ;

GETFILE   ;get file to tally records fo

 +1        KILL XDRFL

 +2       ; XT*7.3*113 input variable XDRNOPT to FILE^XDRDQUE-if UNDEF, allows PATIENT file to be selected

 +3        NEW XDRNOPT

 +4        SET DIC("A")="Tally duplicate entries for which file? "

           DO FILE^XDRDQUE

 +5        IF XDRQFLG

               QUIT 

 +6        SET XDRCNT("GBL")=^DIC(XDRFL,0,"GL")

           SET XDRCNT("GBL")=$PIECE(XDRCNT("GBL"),U,2)

 +7        QUIT 

ZIS        WRITE !!

           KILL ZTSK,ZTQUEUED,IOP

           SET %ZIS="PQM"

           DO ^%ZIS

 +1        IF POP

               SET XDRQFLG=1

               QUIT 

 +2        IF $DATA(IO("Q"))

               DO TSKMN

 +3        QUIT 

TSKMN     ;

 +1        SET ZTIO=$SELECT($DATA(ION):ION,1:IO)

           IF $DATA(IOST)#2

               IF IOST]""

                   SET ZTIO=ZTIO_";"_IOST

 +2        IF $DATA(IO("DOC"))

               IF IO("DOC")]""

                   SET ZTIO=ZTIO_";"_IO("DOC")

 +3        IF $DATA(IOM)#2

               IF IOM

                   SET ZTIO=ZTIO_";"_IOM

                   IF $DATA(IOSL)#2

                       IF IOSL

                           SET ZTIO=ZTIO_";"_IOSL

 +4        KILL ZTSAVE

           SET ZTSAVE("*")=""

 +5        SET ZTRTN="PROCESS^XDRCNT"

           SET ZTDTH=""

           SET ZTDESC="TALLY DUPLICATE RECORD STATUS"

           DO ^%ZTLOAD

           SET XDRQFLG=1

 +6        QUIT 

PROCESS   ;

 +1        NEW X,D,S

 +2       ;S X=0_";"_XDRCNT("GBL") F  S X=$O(^VA(15,"B",X)) Q:X=""!($P(X,";",2)'=XDRCNT("GBL"))  D

 +3        SET X=0_";"_XDRCNT("GBL")

           FOR 

               SET X=$ORDER(^VA(15,"B",X))

               IF X=""

                   QUIT 

               IF $PIECE(X,";",2)=XDRCNT("GBL")

                   Begin DoDot:1

 +4                    SET D=0

                       FOR 

                           SET D=$ORDER(^VA(15,"B",X,D))

                           IF D'=+D

                               QUIT 

                           Begin DoDot:2

 +5                            IF ^VA(15,"B",X,D)=1

                                   QUIT 

 +6                            SET XDRCNT("TOTAL RECS")=XDRCNT("TOTAL RECS")+1

 +7                            SET S=$PIECE(^VA(15,D,0),U,3)

 +8                            IF S=""

 +9                           IF '$TEST

                                   SET XDRCNT("STATUS",S,"CNT")=$GET(XDRCNT("STATUS",S,"CNT"))+1

 +10                           IF S="V"

                                   Begin DoDot:3

 +11                                   SET S=+$PIECE(^VA(15,D,0),U,5)

 +12                                   SET XDRCNT("MERGE STATUS",S,"CNT")=XDRCNT("MERGE STATUS",S,"CNT")+1

                                   End DoDot:3

 +13                           QUIT 

                           End DoDot:2

 +14                   QUIT 

                   End DoDot:1

PRINT     ;print report

 +1        USE IO

 +2        DO HEADER

 +3        WRITE !!,"Total Number of Duplicate Records for File ",$EXTRACT(XDRD(0,0),1,18),":  ",?65,$JUSTIFY(XDRCNT("TOTAL RECS"),6),!

 +4        WRITE !?5,"STATUS field:"

           SET X=0

           FOR 

               SET X=$ORDER(XDRCNT("STATUS",X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +5                IF $Y>(IOSL-5)

                       DO HEADER

                       IF $DATA(XDRCNT("QUIT"))

                           QUIT 

                       WRITE !

 +6                WRITE ?26,$EXTRACT(XDRCNT("STATUS",X,"NAME"),1,34),?65,$JUSTIFY(XDRCNT("STATUS",X,"CNT"),6),!

               End DoDot:1

 +7        WRITE !?5,"MERGE STATUS field:"

           SET X=""

           FOR 

               SET X=$ORDER(XDRCNT("MERGE STATUS",X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +8                IF $Y>(IOSL-5)

                       DO HEADER

                       IF $DATA(XDRCNT("QUIT"))

                           QUIT 

                       WRITE !

 +9                WRITE ?26,$EXTRACT(XDRCNT("MERGE STATUS",X,"NAME"),1,34),?65,$JUSTIFY(XDRCNT("MERGE STATUS",X,"CNT"),6),!

 +10               QUIT 

               End DoDot:1

 +11       IF $EXTRACT(IOST)="C"

               WRITE !!,"End of Report.  Press return to exit"

               READ X:DTIME

 +12       QUIT 

HEADER    ;print header information

 +1        NEW DIR,X,Y

 +2        IF 'XDRCNT("PG")

               GOTO HEADER1

 +3        IF $EXTRACT(IOST)="C"

               IF IO=IO(0)

                   WRITE !

                   SET DIR(0)="EO"

                   DO ^DIR

                   KILL DIR

                   IF Y=0!(Y="^")!($DATA(DTOUT))

                       SET XDRCNT("QUIT")=""

                       QUIT 

HEADER1   ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET XDRCNT("PG")=XDRCNT("PG")+1

 +2        WRITE !?3,$PIECE(^DIC(4,DUZ(2),0),U)

           SET Y=DT

           DO DD^%DT

           WRITE ?50,Y,?70,"Page ",XDRCNT("PG"),?78,!

 +3        WRITE !?12,"TALLY OF DUPLICATE RECORDS' STATUS/MERGE STATUS FIELDS"

 +4        SET XDRCNT("LENG")=7+$LENGTH(XDRD(0,0))

 +5        WRITE !?((80-XDRCNT("LENG"))/2),"FILE:  ",XDRD(0,0),?78,!

 +6        WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")

 +7        QUIT 

INFORM    ;inform user

 +1        WRITE !!,"This report will tally the Status and Merge Status fields for all",!,"entries in the Duplicate record file for the file that you select.",!

 +2        QUIT