source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRCNT.m@ 1710

Last change on this file since 1710 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1XDRCNT ;SF-IRMFO/OHPRD/LAB - Count/Tally records by status/merged status; [ 08/13/92 09:50 AM ] ;11/10/93 13:28 [5/2/96 11:50am]
2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
3 ;;
4START ;
5 D EN^XDRVCHEK
6 D INFORM
7 D INIT
8 D GETFILE
9 G:XDRQFLG EOJ
10 D ZIS
11 G:XDRQFLG EOJ
12 D PROCESS
13 D EOJ
14 Q
15EOJ ;Eoj cleanup
16 K XDRQFLG,XDRD,XDRFL,XDRCNT
17 S:$D(ZTQUEUED) ZTREQ="@"
18 K ZTSK,POP,I,S
19 W:$D(IOF) @IOF
20 D ^%ZISC
21 Q
22INIT ;initialize variables
23 S XDRQFLG=0,XDRCNT("PG")=0
24 S X=$G(^DD(15,.03,0)) I X="" W !!,$C(7),"Dictionary error!! Notify a programmer!" S XDRQFLG=1 Q
25 S X=$P(X,U,3)
26 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)
27 I '$D(XDRCNT("STATUS")) S XDRQFLG=1 W !!,"Dictionary error!! Notify a programmer!" Q
28 S X=$G(^DD(15,.05,0)) I X="" W !!,$C(7),"Dictionary error!! Notify a programmer!" S XDRQFLG=1 Q
29 S X=$P(X,U,3)
30 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)
31 I '$D(XDRCNT("MERGE STATUS")) S XDRQFLG=1 W !!,"Dictionary error!! Notify a programmer!" Q
32 S XDRCNT("TOTAL RECS")=0
33 Q
34 ;
35GETFILE ;get file to tally records fo
36 K XDRFL
37 S DIC("A")="Tally duplicate entries for which file? " D FILE^XDRDQUE
38 Q:XDRQFLG
39 S XDRCNT("GBL")=^DIC(XDRFL,0,"GL"),XDRCNT("GBL")=$P(XDRCNT("GBL"),U,2)
40 Q
41ZIS W !! K ZTSK,ZTQUEUED,IOP S %ZIS="PQM" D ^%ZIS
42 I POP S XDRQFLG=1 Q
43 I $D(IO("Q")) D TSKMN
44 Q
45TSKMN ;
46 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
47 I $D(IO("DOC")),IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC")
48 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
49 K ZTSAVE S ZTSAVE("*")=""
50 S ZTRTN="PROCESS^XDRCNT",ZTDTH="",ZTDESC="TALLY DUPLICATE RECORD STATUS" D ^%ZTLOAD S XDRQFLG=1
51 Q
52PROCESS ;
53 NEW X,D,S
54 ;S X=0_";"_XDRCNT("GBL") F S X=$O(^VA(15,"B",X)) Q:X=""!($P(X,";",2)'=XDRCNT("GBL")) D
55 S X=0_";"_XDRCNT("GBL") F S X=$O(^VA(15,"B",X)) Q:X="" I $P(X,";",2)=XDRCNT("GBL") D
56 . S D=0 F S D=$O(^VA(15,"B",X,D)) Q:D'=+D D
57 . . Q:^VA(15,"B",X,D)=1
58 . . S XDRCNT("TOTAL RECS")=XDRCNT("TOTAL RECS")+1
59 . . S S=$P(^VA(15,D,0),U,3)
60 . . I S=""
61 . . E S XDRCNT("STATUS",S,"CNT")=$G(XDRCNT("STATUS",S,"CNT"))+1
62 . . I S="V" D
63 . . . S S=+$P(^VA(15,D,0),U,5)
64 . . . S XDRCNT("MERGE STATUS",S,"CNT")=XDRCNT("MERGE STATUS",S,"CNT")+1
65 . . Q
66 .Q
67PRINT ;print report
68 U IO
69 D HEADER
70 W !!,"Total Number of Duplicate Records for File ",$E(XDRD(0,0),1,18),": ",?65,$J(XDRCNT("TOTAL RECS"),6),!
71 W !?5,"STATUS field:" S X=0 F S X=$O(XDRCNT("STATUS",X)) Q:X="" D
72 .I $Y>(IOSL-5) D HEADER Q:$D(XDRCNT("QUIT")) W !
73 .W ?26,$E(XDRCNT("STATUS",X,"NAME"),1,34),?65,$J(XDRCNT("STATUS",X,"CNT"),6),!
74 W !?5,"MERGE STATUS field:" S X="" F S X=$O(XDRCNT("MERGE STATUS",X)) Q:X="" D
75 .I $Y>(IOSL-5) D HEADER Q:$D(XDRCNT("QUIT")) W !
76 .W ?26,$E(XDRCNT("MERGE STATUS",X,"NAME"),1,34),?65,$J(XDRCNT("MERGE STATUS",X,"CNT"),6),!
77 .Q
78 I $E(IOST)="C" W !!,"End of Report. Press return to exit" R X:DTIME
79 Q
80HEADER ;print header information
81 N DIR,X,Y
82 I 'XDRCNT("PG") G HEADER1
83 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
84HEADER1 ;
85 W:$D(IOF) @IOF S XDRCNT("PG")=XDRCNT("PG")+1
86 W !?3,$P(^DIC(4,DUZ(2),0),U) S Y=DT D DD^%DT W ?50,Y,?70,"Page ",XDRCNT("PG"),?78,!
87 W !?12,"TALLY OF DUPLICATE RECORDS' STATUS/MERGE STATUS FIELDS"
88 S XDRCNT("LENG")=7+$L(XDRD(0,0))
89 W !?((80-XDRCNT("LENG"))/2),"FILE: ",XDRD(0,0),?78,!
90 W !,$TR($J("",80)," ","-")
91 Q
92INFORM ;inform user
93 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.",!
94 Q
Note: See TracBrowser for help on using the repository browser.