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 ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCDUPR 5120 printed Dec 13, 2024@02:14:56 Page 2
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 ""
