MCDUPR.m

MCDUPR ;WASH/DCB-Reporting of the duplicates ;5/16/96  15:39

 ;;2.3;Medicine;;09/13/1996

START ;

 N POP,%ZIS,ZTSAVE,ZTRTN,ZTDESC,ZTSK

 W @IOF

 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

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

 . S ZTRTN="MAIN^MCDUPR"

 . S ZTSAVE("^TMP($J,""DUP"",")=""

 . S ZTDESC="Removal of Duplication for Medicine"

 . D ^%ZTLOAD K ZTSK

 . Q

 D MAIN

 Q

MAIN ;

 U IO

 I $E(IOST,1,2)="C-" W @IOF

 I $D(^TMP($J,"DUP")) D RPT1,RPT2,^%ZISC

 Q

RPT1 ;Duplicate Static File Entries

 N PGE,CNT,MCNT S (CNT,MCNT)=0 D RPT1H,RPT1M,RPT1F Q

RPT2 ;Pointing to Duplicates

 N PGE,CNT,MCNT,SCNT,S1CNT S (CNT,MCNT,SCNT,S1CNT)=0 D RPT2H,RPT2MA,RPT2F Q

 ;----------------------------------------------

RPT1H ;Header for Duplicate Static File Entries

 N TEMP S TEMP="" S $P(TEMP,"-",80)=""

 W:$G(PGE) @IOF S PGE=$G(PGE)+1

 W "Report 1",?20,"Duplicate Static File Entries",?60,"Page: ",PGE,!

 W !,"STATIC",?8,"STATIC FILE",?35,"DUPLICATE ENTRY"

 W !,"FILE #",?8,"    NAME   ",?35,"IEN",?40,"KEY",!,TEMP,!

 Q 

RPT1M ;Duplicate Static File Entries Main

 N FILE,FILENAME,TMP,SIZE S SIZE=IOM-40

 S FILE="" F  S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE=""  D

 .S FILENAME=$$GET1^DID(FILE,"","","NAME"),MCNT=$G(MCNT)+1

 .S FILENAME=$E(FILENAME,1,26)

 .I ^TMP($J,"DUP","F",FILE)=0 W $$TST("RPT1H",1),FILE,?8,FILENAME,?35,"**** No Duplicates ****" Q

 .S TMP="" F  S TMP=$O(^TMP($J,"DUP","I",FILE,TMP)) Q:TMP=""  D RPT1A(FILE,TMP,FILENAME,SIZE)

 Q

RPT1A(FILE,TMP,FILENAME,SIZE) ;

 N LOOP,REC,REC2,TEMP,LINES,MULTI,TEXT,BEG,END

 S REC="" F  S REC=+$O(^TMP($J,"DUP","I",FILE,TMP,REC)) Q:REC=0  D

 .Q:'$D(^TMP($J,"DUP","I",FILE,TMP,REC,1))

 .Q:$P(^TMP($J,"DUP","I",FILE,TMP,REC,1),U,2)="*"

 .F LOOP=1:1 S REC2=$P($G(^TMP($J,"DUP","I",FILE,TMP,REC,1)),U,LOOP) Q:REC2="*"  D

 ..S TEMP=^TMP($J,"DUP","I",FILE,TMP,REC2,0),CNT=$G(CNT)+1

 ..S TEXT=TMP_TEMP

 ..W $$TST("RPT1H",1),FILE,?8,FILENAME,?35,REC2,?40,$E(TEXT,1,SIZE)

 ..I $L(TEXT)>SIZE D

 ...S LINES=$L(TEXT)\SIZE

 ...F MULTI=1:1:LINES D

 ....S BEG=SIZE*MULTI+1,END=BEG+SIZE S:END>$L(TEXT) END=$L(TEXT)

 ....W $$TST("RPT1H",1),?40,$E(TEXT,BEG,END)

 Q

RPT1F ;Duplicate Static File Entries

 N TEMP,DIR S TEMP="" S $P(TEMP,"-",80)=""

 W "FILES: ",$$TST("RPT1H",3),TEMP,!,"TOTALS",!,"FILES: ",MCNT,?35,"DUPLICATES: ",$G(CNT)

 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR

 W @IOF

 Q

 ;-------------------------------------------------------------------

RPT2H ;Header for Pointing to Duplicates

 N TEMP S TEMP="" S $P(TEMP,"-",80)=""

 W:$G(PGE) @IOF S PGE=$G(PGE)+1

 W "Report 2",?20,"Pointing to Duplicates",?60,"Page: ",PGE,!

 W !,?56,"SUB",?64,"SUB"

 W !,"STATIC",?8,"OLD",?16,"NEW",?24,"FROM  ",?32,"MAIN",?40,"SUB",?48,"SUB",?56,"SUB",?64,"SUB"

 W !,"FILE #",?8,"IEN",?16,"IEN",?24,"FILE #",?32,"IEN ",?40,"FILE",?48,"IEN",?56,"FILE",?64,"IEN"

 W !,TEMP,!

 Q

RPT2MA ;Main Print for Pointing to Duplicates

 N FILE,TMP,TEMP,NIEN,OIEN,EX

 S FILE="" F  S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE=""  D

 .Q:^TMP($J,"DUP","F",FILE)=0

 .Q:'$D(^TMP($J,"DUP","J",FILE))

 .S CNT=$G(CNT)+1,TMP=""

 .F  S TMP=$O(^TMP($J,"DUP","J",FILE,TMP)) Q:TMP=""  D

 ..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")

 ..S EX="D RPT2"_$P(TEMP,U)_"(FILE,TEMP,OIEN,NIEN)"

 ..X EX

 Q

RPT2M(SFILE,TEMP,OIEN,NIEN) ;Pointing to with a Main File

 N MAINFILE,MAINREC S (MAINFILE,MAINREC)=""

 D RPT2B(TEMP,.MAINFILE,.MAINREC)

 W $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,"N/A"

 Q

RPT2S(SFILE,TEMP,OIEN,NIEN) ;Pointing to with Sub-File

 N MAINFILE,MAINREC,SUBFILE,SUBREC S (MAINFILE,MAINREC,SUBFILE,SUBREC)=""

 D RPT2B(TEMP,.MAINFILE,.MAINREC),RPT2C(TEMP,.SUBFILE,.SUBREC)

 W $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,SUBFILE,?48,SUBREC

 Q

RPT2SS(SFILE,TEMP,OIEN,NIEN) ;Pointing to with sub-file within sub-file

 N MAINFILE,MAINREC,SUBFILE,SUBREC,SUBFILE1,SUBREC1 S (MAINFILE,MAINREC,SUBFILE,SUBREC)=""

 D RPT2B(TEMP,.MAINFILE,.MAINREC),RPT2C(TEMP,.SUBFILE,.SUBREC)

 S SUBFILE=$P(TEMP,U,6),SUBREC=$P(TEMP,U,7)

 S SUBFILE1=$P(TEMP,U,10),SUBREC1=$P(TEMP,U,11)

 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

 Q

RPT2B(TEMP,MFILE,MREC) ;Get main file and main record

 S MFILE=$P(TEMP,U,2),MREC=$P(TEMP,U,3),MCNT=$G(MCNT)+1

 Q

RPT2C(TEMP,SFILE,SREC) ;Get Sub-file and sub-record

 S SFILE=$P(TEMP,U,6),SREC=$P(TEMP,U,7),SCNT=$G(SCNT)+1

 Q

RPT2F ;Footer for Pointing to Duplicates

 N TEMP,DIR S TEMP="" S $P(TEMP,"-",80)=""

 W $$TST("RPT2H",3),TEMP

 W !,"TOTALS:",!,?2,$G(CNT),?24,$G(MCNT),?40,$G(SCNT),?56,$G(S1CNT)

 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR

 W @IOF

 Q

TST(RTN,SKIP) ;Checks $Y and does formfeed if needed and skips the new lines

 N LINE,DIR

 I ($Y+SKIP+$S($E(IOST,1,2)="C-":2,1:4))>IOSL D

 .I $E(IOST,1,2)="C-" S DIR(0)="E",DIR("A")="Press RETURN to continue: " D ^DIR

 .D @RTN S SKIP=1

 F LINE=1:1:SKIP W !

 Q ""

MCDUPR    ;WASH/DCB-Reporting of the duplicates ;5/16/96  15:39

 +1       ;;2.3;Medicine;;09/13/1996

START     ;

 +1        NEW POP,%ZIS,ZTSAVE,ZTRTN,ZTDESC,ZTSK

 +2        WRITE @IOF

 +3        KILL IO("Q")

           SET %ZIS="MQ"

           SET %ZIS("B")="Q"

           SET %ZIS("A")="This report should be captured on a printer for documentation purposes!!  "

           DO ^%ZIS

           IF POP

               QUIT 

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

               Begin DoDot:1

 +5                SET ZTRTN="MAIN^MCDUPR"

 +6                SET ZTSAVE("^TMP($J,""DUP"",")=""

 +7                SET ZTDESC="Removal of Duplication for Medicine"

 +8                DO ^%ZTLOAD

                   KILL ZTSK

 +9                QUIT 

               End DoDot:1

               QUIT 

 +10       DO MAIN

 +11       QUIT 

MAIN      ;

 +1        USE IO

 +2        IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

 +3        IF $DATA(^TMP($JOB,"DUP"))

               DO RPT1

               DO RPT2

               DO ^%ZISC

 +4        QUIT 

RPT1      ;Duplicate Static File Entries

 +1        NEW PGE,CNT,MCNT

           SET (CNT,MCNT)=0

           DO RPT1H

           DO RPT1M

           DO RPT1F

           QUIT 

RPT2      ;Pointing to Duplicates

 +1        NEW PGE,CNT,MCNT,SCNT,S1CNT

           SET (CNT,MCNT,SCNT,S1CNT)=0

           DO RPT2H

           DO RPT2MA

           DO RPT2F

           QUIT 

 +2       ;----------------------------------------------

RPT1H     ;Header for Duplicate Static File Entries

 +1        NEW TEMP

           SET TEMP=""

           SET $PIECE(TEMP,"-",80)=""

 +2        IF $GET(PGE)

               WRITE @IOF

           SET PGE=$GET(PGE)+1

 +3        WRITE "Report 1",?20,"Duplicate Static File Entries",?60,"Page: ",PGE,!

 +4        WRITE !,"STATIC",?8,"STATIC FILE",?35,"DUPLICATE ENTRY"

 +5        WRITE !,"FILE #",?8,"    NAME   ",?35,"IEN",?40,"KEY",!,TEMP,!

 +6        QUIT 

RPT1M     ;Duplicate Static File Entries Main

 +1        NEW FILE,FILENAME,TMP,SIZE

           SET SIZE=IOM-40

 +2        SET FILE=""

           FOR 

               SET FILE=$ORDER(^TMP($JOB,"DUP","F",FILE))

               IF FILE=""

                   QUIT 

               Begin DoDot:1

 +3                SET FILENAME=$$GET1^DID(FILE,"","","NAME")

                   SET MCNT=$GET(MCNT)+1

 +4                SET FILENAME=$EXTRACT(FILENAME,1,26)

 +5                IF ^TMP($JOB,"DUP","F",FILE)=0

                       WRITE $$TST("RPT1H",1),FILE,?8,FILENAME,?35,"**** No Duplicates ****"

                       QUIT 

 +6                SET TMP=""

                   FOR 

                       SET TMP=$ORDER(^TMP($JOB,"DUP","I",FILE,TMP))

                       IF TMP=""

                           QUIT 

                       DO RPT1A(FILE,TMP,FILENAME,SIZE)

               End DoDot:1

 +7        QUIT 

RPT1A(FILE,TMP,FILENAME,SIZE) ;

 +1        NEW LOOP,REC,REC2,TEMP,LINES,MULTI,TEXT,BEG,END

 +2        SET REC=""

           FOR 

               SET REC=+$ORDER(^TMP($JOB,"DUP","I",FILE,TMP,REC))

               IF REC=0

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^TMP($JOB,"DUP","I",FILE,TMP,REC,1))

                       QUIT 

 +4                IF $PIECE(^TMP($JOB,"DUP","I",FILE,TMP,REC,1),U,2)="*"

                       QUIT 

 +5                FOR LOOP=1:1

                       SET REC2=$PIECE($GET(^TMP($JOB,"DUP","I",FILE,TMP,REC,1)),U,LOOP)

                       IF REC2="*"

                           QUIT 

                       Begin DoDot:2

 +6                        SET TEMP=^TMP($JOB,"DUP","I",FILE,TMP,REC2,0)

                           SET CNT=$GET(CNT)+1

 +7                        SET TEXT=TMP_TEMP

 +8                        WRITE $$TST("RPT1H",1),FILE,?8,FILENAME,?35,REC2,?40,$EXTRACT(TEXT,1,SIZE)

 +9                        IF $LENGTH(TEXT)>SIZE

                               Begin DoDot:3

 +10                               SET LINES=$LENGTH(TEXT)\SIZE

 +11                               FOR MULTI=1:1:LINES

                                       Begin DoDot:4

 +12                                       SET BEG=SIZE*MULTI+1

                                           SET END=BEG+SIZE

                                           IF END>$LENGTH(TEXT)

                                               SET END=$LENGTH(TEXT)

 +13                                       WRITE $$TST("RPT1H",1),?40,$EXTRACT(TEXT,BEG,END)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +14       QUIT 

RPT1F     ;Duplicate Static File Entries

 +1        NEW TEMP,DIR

           SET TEMP=""

           SET $PIECE(TEMP,"-",80)=""

 +2        WRITE "FILES: ",$$TST("RPT1H",3),TEMP,!,"TOTALS",!,"FILES: ",MCNT,?35,"DUPLICATES: ",$GET(CNT)

 +3        IF $EXTRACT(IOST,1,2)="C-"

               SET DIR(0)="E"

               DO ^DIR

 +4        WRITE @IOF

 +5        QUIT 

 +6       ;-------------------------------------------------------------------

RPT2H     ;Header for Pointing to Duplicates

 +1        NEW TEMP

           SET TEMP=""

           SET $PIECE(TEMP,"-",80)=""

 +2        IF $GET(PGE)

               WRITE @IOF

           SET PGE=$GET(PGE)+1

 +3        WRITE "Report 2",?20,"Pointing to Duplicates",?60,"Page: ",PGE,!

 +4        WRITE !,?56,"SUB",?64,"SUB"

 +5        WRITE !,"STATIC",?8,"OLD",?16,"NEW",?24,"FROM  ",?32,"MAIN",?40,"SUB",?48,"SUB",?56,"SUB",?64,"SUB"

 +6        WRITE !,"FILE #",?8,"IEN",?16,"IEN",?24,"FILE #",?32,"IEN ",?40,"FILE",?48,"IEN",?56,"FILE",?64,"IEN"

 +7        WRITE !,TEMP,!

 +8        QUIT 

RPT2MA    ;Main Print for Pointing to Duplicates

 +1        NEW FILE,TMP,TEMP,NIEN,OIEN,EX

 +2        SET FILE=""

           FOR 

               SET FILE=$ORDER(^TMP($JOB,"DUP","F",FILE))

               IF FILE=""

                   QUIT 

               Begin DoDot:1

 +3                IF ^TMP($JOB,"DUP","F",FILE)=0

                       QUIT 

 +4                IF '$DATA(^TMP($JOB,"DUP","J",FILE))

                       QUIT 

 +5                SET CNT=$GET(CNT)+1

                   SET TMP=""

 +6                FOR 

                       SET TMP=$ORDER(^TMP($JOB,"DUP","J",FILE,TMP))

                       IF TMP=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET TEMP=^TMP($JOB,"DUP","J",FILE,TMP,1)

                           SET OIEN=^TMP($JOB,"DUP","J",FILE,TMP,"OLD")

                           SET NIEN=^TMP($JOB,"DUP","J",FILE,TMP,"NEW")

 +8                        SET EX="D RPT2"_$PIECE(TEMP,U)_"(FILE,TEMP,OIEN,NIEN)"

 +9                        XECUTE EX

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

RPT2M(SFILE,TEMP,OIEN,NIEN) ;Pointing to with a Main File

 +1        NEW MAINFILE,MAINREC

           SET (MAINFILE,MAINREC)=""

 +2        DO RPT2B(TEMP,.MAINFILE,.MAINREC)

 +3        WRITE $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,"N/A"

 +4        QUIT 

RPT2S(SFILE,TEMP,OIEN,NIEN) ;Pointing to with Sub-File

 +1        NEW MAINFILE,MAINREC,SUBFILE,SUBREC

           SET (MAINFILE,MAINREC,SUBFILE,SUBREC)=""

 +2        DO RPT2B(TEMP,.MAINFILE,.MAINREC)

           DO RPT2C(TEMP,.SUBFILE,.SUBREC)

 +3        WRITE $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,SUBFILE,?48,SUBREC

 +4        QUIT 

RPT2SS(SFILE,TEMP,OIEN,NIEN) ;Pointing to with sub-file within sub-file

 +1        NEW MAINFILE,MAINREC,SUBFILE,SUBREC,SUBFILE1,SUBREC1

           SET (MAINFILE,MAINREC,SUBFILE,SUBREC)=""

 +2        DO RPT2B(TEMP,.MAINFILE,.MAINREC)

           DO RPT2C(TEMP,.SUBFILE,.SUBREC)

 +3        SET SUBFILE=$PIECE(TEMP,U,6)

           SET SUBREC=$PIECE(TEMP,U,7)

 +4        SET SUBFILE1=$PIECE(TEMP,U,10)

           SET SUBREC1=$PIECE(TEMP,U,11)

 +5        WRITE $$TST("RPT2H",1),SFILE,?8,OIEN,?16,NIEN,?24,MAINFILE,?32,MAINREC,?40,SUBFILE1,?48,SUBREC1,?56,SUBFILE,?64,SUBREC

           SET S1CNT=$GET(S1CNT)+1

 +6        QUIT 

RPT2B(TEMP,MFILE,MREC) ;Get main file and main record

 +1        SET MFILE=$PIECE(TEMP,U,2)

           SET MREC=$PIECE(TEMP,U,3)

           SET MCNT=$GET(MCNT)+1

 +2        QUIT 

RPT2C(TEMP,SFILE,SREC) ;Get Sub-file and sub-record

 +1        SET SFILE=$PIECE(TEMP,U,6)

           SET SREC=$PIECE(TEMP,U,7)

           SET SCNT=$GET(SCNT)+1

 +2        QUIT 

RPT2F     ;Footer for Pointing to Duplicates

 +1        NEW TEMP,DIR

           SET TEMP=""

           SET $PIECE(TEMP,"-",80)=""

 +2        WRITE $$TST("RPT2H",3),TEMP

 +3        WRITE !,"TOTALS:",!,?2,$GET(CNT),?24,$GET(MCNT),?40,$GET(SCNT),?56,$GET(S1CNT)

 +4        IF $EXTRACT(IOST,1,2)="C-"

               SET DIR(0)="E"

               DO ^DIR

 +5        WRITE @IOF

 +6        QUIT 

TST(RTN,SKIP) ;Checks $Y and does formfeed if needed and skips the new lines

 +1        NEW LINE,DIR

 +2        IF ($Y+SKIP+$SELECT($EXTRACT(IOST,1,2)="C-":2,1:4))>IOSL

               Begin DoDot:1

 +3                IF $EXTRACT(IOST,1,2)="C-"

                       SET DIR(0)="E"

                       SET DIR("A")="Press RETURN to continue: "

                       DO ^DIR

 +4                DO @RTN

                   SET SKIP=1

               End DoDot:1

 +5        FOR LINE=1:1:SKIP

               WRITE !

 +6        QUIT ""