source: FOIAVistA/tag/r/MEDICINE-MC/MCDUPR.m@ 1767

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1MCDUPR ;WASH/DCB-Reporting of the duplicates ;5/16/96 15:39
2 ;;2.3;Medicine;;09/13/1996
3START ;
4 N POP,%ZIS,ZTSAVE,ZTRTN,ZTDESC,ZTSK
5 W @IOF
6 K IO("Q") S %ZIS="MQ",%ZIS("B")="Q",%ZIS("A")="This report should be captured on a printer for documentation purposes!! " D ^%ZIS I POP Q
7 I $D(IO("Q")) D Q
8 . S ZTRTN="MAIN^MCDUPR"
9 . S ZTSAVE("^TMP($J,""DUP"",")=""
10 . S ZTDESC="Removal of Duplication for Medicine"
11 . D ^%ZTLOAD K ZTSK
12 . Q
13 D MAIN
14 Q
15MAIN ;
16 U IO
17 I $E(IOST,1,2)="C-" W @IOF
18 I $D(^TMP($J,"DUP")) D RPT1,RPT2,^%ZISC
19 Q
20RPT1 ;Duplicate Static File Entries
21 N PGE,CNT,MCNT S (CNT,MCNT)=0 D RPT1H,RPT1M,RPT1F Q
22RPT2 ;Pointing to Duplicates
23 N PGE,CNT,MCNT,SCNT,S1CNT S (CNT,MCNT,SCNT,S1CNT)=0 D RPT2H,RPT2MA,RPT2F Q
24 ;----------------------------------------------
25RPT1H ;Header for Duplicate Static File Entries
26 N TEMP S TEMP="" S $P(TEMP,"-",80)=""
27 W:$G(PGE) @IOF S PGE=$G(PGE)+1
28 W "Report 1",?20,"Duplicate Static File Entries",?60,"Page: ",PGE,!
29 W !,"STATIC",?8,"STATIC FILE",?35,"DUPLICATE ENTRY"
30 W !,"FILE #",?8," NAME ",?35,"IEN",?40,"KEY",!,TEMP,!
31 Q
32RPT1M ;Duplicate Static File Entries Main
33 N FILE,FILENAME,TMP,SIZE S SIZE=IOM-40
34 S FILE="" F S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE="" D
35 .S FILENAME=$$GET1^DID(FILE,"","","NAME"),MCNT=$G(MCNT)+1
36 .S FILENAME=$E(FILENAME,1,26)
37 .I ^TMP($J,"DUP","F",FILE)=0 W $$TST("RPT1H",1),FILE,?8,FILENAME,?35,"**** No Duplicates ****" Q
38 .S TMP="" F S TMP=$O(^TMP($J,"DUP","I",FILE,TMP)) Q:TMP="" D RPT1A(FILE,TMP,FILENAME,SIZE)
39 Q
40RPT1A(FILE,TMP,FILENAME,SIZE) ;
41 N LOOP,REC,REC2,TEMP,LINES,MULTI,TEXT,BEG,END
42 S REC="" F S REC=+$O(^TMP($J,"DUP","I",FILE,TMP,REC)) Q:REC=0 D
43 .Q:'$D(^TMP($J,"DUP","I",FILE,TMP,REC,1))
44 .Q:$P(^TMP($J,"DUP","I",FILE,TMP,REC,1),U,2)="*"
45 .F LOOP=1:1 S REC2=$P($G(^TMP($J,"DUP","I",FILE,TMP,REC,1)),U,LOOP) Q:REC2="*" D
46 ..S TEMP=^TMP($J,"DUP","I",FILE,TMP,REC2,0),CNT=$G(CNT)+1
47 ..S TEXT=TMP_TEMP
48 ..W $$TST("RPT1H",1),FILE,?8,FILENAME,?35,REC2,?40,$E(TEXT,1,SIZE)
49 ..I $L(TEXT)>SIZE D
50 ...S LINES=$L(TEXT)\SIZE
51 ...F MULTI=1:1:LINES D
52 ....S BEG=SIZE*MULTI+1,END=BEG+SIZE S:END>$L(TEXT) END=$L(TEXT)
53 ....W $$TST("RPT1H",1),?40,$E(TEXT,BEG,END)
54 Q
55RPT1F ;Duplicate Static File Entries
56 N TEMP,DIR S TEMP="" S $P(TEMP,"-",80)=""
57 W "FILES: ",$$TST("RPT1H",3),TEMP,!,"TOTALS",!,"FILES: ",MCNT,?35,"DUPLICATES: ",$G(CNT)
58 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
59 W @IOF
60 Q
61 ;-------------------------------------------------------------------
62RPT2H ;Header for Pointing to Duplicates
63 N TEMP S TEMP="" S $P(TEMP,"-",80)=""
64 W:$G(PGE) @IOF S PGE=$G(PGE)+1
65 W "Report 2",?20,"Pointing to Duplicates",?60,"Page: ",PGE,!
66 W !,?56,"SUB",?64,"SUB"
67 W !,"STATIC",?8,"OLD",?16,"NEW",?24,"FROM ",?32,"MAIN",?40,"SUB",?48,"SUB",?56,"SUB",?64,"SUB"
68 W !,"FILE #",?8,"IEN",?16,"IEN",?24,"FILE #",?32,"IEN ",?40,"FILE",?48,"IEN",?56,"FILE",?64,"IEN"
69 W !,TEMP,!
70 Q
71RPT2MA ;Main Print for Pointing to Duplicates
72 N FILE,TMP,TEMP,NIEN,OIEN,EX
73 S FILE="" F S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE="" D
74 .Q:^TMP($J,"DUP","F",FILE)=0
75 .Q:'$D(^TMP($J,"DUP","J",FILE))
76 .S CNT=$G(CNT)+1,TMP=""
77 .F S TMP=$O(^TMP($J,"DUP","J",FILE,TMP)) Q:TMP="" D
78 ..S TEMP=^TMP($J,"DUP","J",FILE,TMP,1),OIEN=^TMP($J,"DUP","J",FILE,TMP,"OLD"),NIEN=^TMP($J,"DUP","J",FILE,TMP,"NEW")
79 ..S EX="D RPT2"_$P(TEMP,U)_"(FILE,TEMP,OIEN,NIEN)"
80 ..X EX
81 Q
82RPT2M(SFILE,TEMP,OIEN,NIEN) ;Pointing to with a Main File
83 N MAINFILE,MAINREC S (MAINFILE,MAINREC)=""
84 D RPT2B(TEMP,.MAINFILE,.MAINREC)
85 W $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,"N/A"
86 Q
87RPT2S(SFILE,TEMP,OIEN,NIEN) ;Pointing to with Sub-File
88 N MAINFILE,MAINREC,SUBFILE,SUBREC S (MAINFILE,MAINREC,SUBFILE,SUBREC)=""
89 D RPT2B(TEMP,.MAINFILE,.MAINREC),RPT2C(TEMP,.SUBFILE,.SUBREC)
90 W $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,SUBFILE,?48,SUBREC
91 Q
92RPT2SS(SFILE,TEMP,OIEN,NIEN) ;Pointing to with sub-file within sub-file
93 N MAINFILE,MAINREC,SUBFILE,SUBREC,SUBFILE1,SUBREC1 S (MAINFILE,MAINREC,SUBFILE,SUBREC)=""
94 D RPT2B(TEMP,.MAINFILE,.MAINREC),RPT2C(TEMP,.SUBFILE,.SUBREC)
95 S SUBFILE=$P(TEMP,U,6),SUBREC=$P(TEMP,U,7)
96 S SUBFILE1=$P(TEMP,U,10),SUBREC1=$P(TEMP,U,11)
97 W $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,SUBFILE1,?48,SUBREC1,?56,SUBFILE,?64,SUBREC S S1CNT=$G(S1CNT)+1
98 Q
99RPT2B(TEMP,MFILE,MREC) ;Get main file and main record
100 S MFILE=$P(TEMP,U,2),MREC=$P(TEMP,U,3),MCNT=$G(MCNT)+1
101 Q
102RPT2C(TEMP,SFILE,SREC) ;Get Sub-file and sub-record
103 S SFILE=$P(TEMP,U,6),SREC=$P(TEMP,U,7),SCNT=$G(SCNT)+1
104 Q
105RPT2F ;Footer for Pointing to Duplicates
106 N TEMP,DIR S TEMP="" S $P(TEMP,"-",80)=""
107 W $$TST("RPT2H",3),TEMP
108 W !,"TOTALS:",!,?2,$G(CNT),?24,$G(MCNT),?40,$G(SCNT),?56,$G(S1CNT)
109 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
110 W @IOF
111 Q
112TST(RTN,SKIP) ;Checks $Y and does formfeed if needed and skips the new lines
113 N LINE,DIR
114 I ($Y+SKIP+$S($E(IOST,1,2)="C-":2,1:4))>IOSL D
115 .I $E(IOST,1,2)="C-" S DIR(0)="E",DIR("A")="Press RETURN to continue: " D ^DIR
116 .D @RTN S SKIP=1
117 F LINE=1:1:SKIP W !
118 Q ""
Note: See TracBrowser for help on using the repository browser.