DG53244V ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
;;5.3;Registration;**244,1015**;Aug 13, 1993;Build 21
;
PRT ;Do report output
I '$D(ZTQUEUED),$E(IOST)="C" D WAIT^DICD
N DGOUT,DGLINE,DGTITL,DGPAGE,DGPG,DGNMSP,DGPNOW
S DGOUT=0,DGNMSP="DPTNAME"
D RUN^DG53244U(DGFLAG) Q:DGOUT
D HINI D:DGFMT="D" GDETAIL D STOP Q:DGOUT
I $E(IOST)="C" D END
I DGFMT="D" D
.D HDR(0) Q:DGOUT D PARAM Q:DGOUT
.D HDR(1) Q:DGOUT D PDETAIL
.Q
Q:DGOUT
D HDR(2),STATS(0)
Q:DGOUT
I $E(IOST)="C" N DIR S DIR(0)="E" W ! D ^DIR
K DGLIM,DGFLAG,DGFMT,DGFLD,DGEXC,^TMP(DGNMSP,$J)
Q
;
STATS(DGXM) ;Print statistics page
;Input: DGXM=number > 0 to set array for mailman--
; pass by reference (optional)
;
N DGI,DGY,DGX,DGFILE,DGFLD,DGET,DGPDT,DGTOT,DGSEC
S DGXM=+$G(DGXM),(DGET,DGFILE,DGTOT,DGSEC)=0
I DGXM D Q:DGOUT
.S DGX=" " D SOUT Q:DGOUT
.S DGY="Patient Name Conversion Statistics",DGX=""
.S $E(DGX,(80-$L(DGY)\2))=DGY D SOUT Q:DGOUT
.S DGX=$E(DGLINE,1,80) D SOUT Q:DGOUT
.S DGX="Field",$E(DGX,30)="Evaluated",$E(DGX,41)="Changed"
.S $E(DGX,50)="Type 1",$E(DGX,58)="Type 2",$E(DGX,66)="Type 3"
.S $E(DGX,74)="Type 4" D SOUT Q:DGOUT
.S DGX=$E(DGLINE,1,80) D SOUT
.Q
F S DGFILE=$O(^XTMP(DGNMSP,"STATS",DGFILE)) Q:'DGFILE!DGOUT D
.S DGFLD=0
.F S DGFLD=$O(^XTMP(DGNMSP,"STATS",DGFILE,DGFLD)) Q:'DGFLD!DGOUT D
..S DGY=^XTMP(DGNMSP,"STATS",DGFILE,DGFLD),DGX=DGFILE_","_DGFLD
..S $E(DGX,10)=$P(DGY,U,7),$E(DGX,30)=$J(+$P(DGY,U),9,0)
..S $E(DGX,41)=$J(+$P(DGY,U,2),7,0),$E(DGX,50)=$J(+$P(DGY,U,3),6,0)
..S $E(DGX,58)=$J(+$P(DGY,U,4),6,0),$E(DGX,66)=$J(+$P(DGY,U,5),6,0)
..S $E(DGX,74)=$J(+$P(DGY,U,6),6,0),DGET=DGET+$P(DGY,U)
..D SOUT
..Q
.Q
Q:DGOUT S DGX=$E(DGLINE,1,80)
D SOUT Q:DGOUT
S DGY=^XTMP(DGNMSP,"STATS")
S DGX="REPORT TOTAL:",$E(DGX,30)=$J(DGET,9,0)
S $E(DGX,41)=$J(+$P(DGY,U,3),7,0),$E(DGX,50)=$J(+$P(DGY,U,4),6,0)
S $E(DGX,58)=$J(+$P(DGY,U,5),6,0),$E(DGX,66)=$J(+$P(DGY,U,6),6,0)
S $E(DGX,74)=$J(+$P(DGY,U,7),6,0)
D SOUT Q:DGOUT S DGX=" " D SOUT Q:DGOUT S DGX=""
S $E(DGX,10)="Exception types: 1 Name value contains no comma"
D SOUT Q:DGOUT S DGX=""
S $E(DGX,27)="2 Parenthetical text is removed from name"
D SOUT Q:DGOUT S DGX=""
S $E(DGX,27)="3 Name value cannot be converted"
D SOUT Q:DGOUT S DGX=""
S $E(DGX,27)="4 Characters are removed or changed"
D SOUT Q:DGOUT S DGX=" " D SOUT Q:DGOUT S DGX=""
S $E(DGX,24)="Total name values evaluated: "_$J(+DGY,7,0)
D SOUT Q:DGOUT S DGX=""
S $E(DGX,20)="Total patient records to change: "_$J(+$P(DGY,U,2),7,0)
D SOUT Q:DGOUT
S DGPDT=$G(^XTMP(DGNMSP,0,0)) Q:'DGPDT
S DGX=" " D SOUT S DGX="" Q:DGOUT
S $E(DGX,12)="Name conversion processing started "_$$FMTE^XLFDT(+DGPDT)
D SOUT S DGX="" Q:DGOUT
I $P(DGPDT,U,2) D Q:DGOUT
.S $E(DGX,12)="Name conversion processing completed "_$$FMTE^XLFDT($P(DGPDT,U,2))
.D SOUT Q
S DGX=" " D SOUT Q:DGOUT
S DGI=0 F S DGI=$O(^XTMP(DGNMSP,0,DGI)) Q:'DGI!DGOUT D
.S DGY=^XTMP(DGNMSP,0,DGI),DGX=""
.S $E(DGX,1)=DGI_". "_$$FMTE^XLFDT($P(DGY,U))
.I $P(DGY,U,2) D
..S DGX=DGX_" to "_$$FMTE^XLFDT($P(DGY,U,2))
..S DGSEC=DGSEC+$$FMDIFF^XLFDT($P(DGY,U,2),$P(DGY,U),2)
.I $P(DGY,U,4) D
..S DGX=DGX_", names processed: "_($P(DGY,U,4)-$P(DGY,U,3))
..S DGTOT=DGTOT+($P(DGY,U,4)-$P(DGY,U,3))
..Q
.D SOUT
.Q
Q:'DGSEC!DGOUT
S DGX=" " D SOUT Q:DGOUT
S DGY="Processing time: "_$$TIME(DGSEC)
S DGX="",$E(DGX,(80-$L(DGY)\2))=DGY
D SOUT Q:'DGTOT!DGOUT
S DGY="Processing rate: "_(DGTOT\(DGSEC/3600))_" name values per hour"
S DGX="",$E(DGX,(80-$L(DGY)\2))=DGY D SOUT
Q
;
SOUT ;Output statistics line
I DGXM S DGXM=DGXM+1,DGXM(DGXM,0)=DGX Q
D:$Y>(IOSL-3) HDR(2) Q:DGOUT W !?26,DGX
Q
;
GDETAIL ;Generate report detail global
K ^TMP(DGNMSP,$J)
N DGNAME,DFN,DGFILE,DGIFN,DGFIELD,DGX,DGTYPE,DGSSN
S DGNAME=""
F S DGNAME=$O(^XTMP(DGNMSP,"B",DGNAME)) Q:DGNAME="" S DFN=0 D
.F S DFN=$O(^XTMP(DGNMSP,"B",DGNAME,DFN)) Q:'DFN S DGFILE=0 D
..S DGSSN=$P($G(^DPT(DFN,0)),U,9)
..F S DGFILE=$O(^XTMP(DGNMSP,DFN,DGFILE)) Q:'DGFILE S DGIFN=0 D
...F S DGIFN=$O(^XTMP(DGNMSP,DFN,DGFILE,DGIFN)) Q:'DGIFN D
....S DGFIELD=0
....F S DGFIELD=$O(^XTMP(DGNMSP,DFN,DGFILE,DGIFN,DGFIELD)) Q:'DGFIELD D
.....Q:'$$OKFLD(DGFILE,DGFIELD)
.....S DGX=^XTMP(DGNMSP,DFN,DGFILE,DGIFN,DGFIELD),DGTYPE=$P(DGX,U,3)
.....Q:'$$OKTYP(DGTYPE)
.....S ^TMP(DGNMSP,$J,DGNAME,DFN,DGFILE,DGIFN,DGFIELD)=DGSSN_U_DGX
.....Q
....Q
...Q
..Q
.Q
Q
;
PDETAIL ;Print report detail
N DGNAME,DFN,DGFILE,DGIFN,DGFIELD,DGX,DGR
S (DGR,DGNAME)=""
F S DGNAME=$O(^TMP(DGNMSP,$J,DGNAME)) Q:DGNAME=""!DGOUT S DFN=0 D
.F S DFN=$O(^TMP(DGNMSP,$J,DGNAME,DFN)) Q:'DFN!DGOUT S DGFILE=0 D
..F S DGFILE=$O(^TMP(DGNMSP,$J,DGNAME,DFN,DGFILE)) Q:'DGFILE!DGOUT D
...S DGIFN=0
...F S DGIFN=$O(^TMP(DGNMSP,$J,DGNAME,DFN,DGFILE,DGIFN)) Q:'DGIFN!DGOUT D
....S DGFIELD=0
....F S DGFIELD=$O(^TMP(DGNMSP,$J,DGNAME,DFN,DGFILE,DGIFN,DGFIELD)) Q:'DGFIELD!DGOUT D
.....S DGX=^TMP(DGNMSP,$J,DGNAME,DFN,DGFILE,DGIFN,DGFIELD)
.....D:$Y>(IOSL-3) HDR(1) Q:DGOUT
.....W ! I DGR'=DFN W $E(DGNAME,1,20),?22,$P(DGX,U) S DGR=DFN
.....W ?33,$P(^XTMP(DGNMSP,"STATS",DGFILE,DGFIELD),U,7)
.....W ?54,$P(DGX,U,2),?90,$P(DGX,U,3),?125,$$EXC($P(DGX,U,4))
.....Q
....Q
...Q
..Q
.Q
Q
;
EXC(DGE) ;Format exception types with commas
N DGI,DGX S DGX=""
F DGI=1:1:$L(DGE) S DGX=DGX_$E(DGE,DGI)_","
Q $E(DGX,1,($L(DGX)-1))
;
OKFLD(DGFILE,DGFIELD) ;Check field screen
Q:DGFLD="A" 1
I DGFIELD=.01 Q ($D(DGFLD(DGFIELD))&(DGFILE=2))
I DGFILE=2.01 Q $D(DGFLD(DGFILE))
Q:$D(DGFLD(DGFIELD)) 1
Q:$D(DGFLD(DGFILE)) 1
Q 0
;
OKTYP(DGTYPE) ;Check exception types
N DGI,DGOK S (DGI,DGOK)=0
F Q:DGOK S DGI=$O(DGEXC(DGI)) Q:'DGI S:DGTYPE[DGI DGOK=1
Q DGOK
;
PARAM N DGEND S DGEND=0
W !!?(IOM\2-25),"The following report parameters have been selected:"
W !!?(IOM\2-28),"Report generation action: ",DGFLAG(DGFLAG)
W !?(IOM\2-28)," Report format: ",DGFMT(DGFMT)
W !?(IOM\2-28)," Fields to return:" S DGEND=0
S DGI="" F S DGI=$O(DGFLD(DGI)) Q:DGI="" D
.W:DGEND ! W ?(IOM\2-1),DGFLD(DGI) S DGEND=1
.Q
W !?(IOM\2-28)," Exceptions to report:" S DGEND=0
S DGI="" F S DGI=$O(DGEXC(DGI)) Q:DGI="" D
.W:DGEND ! W ?(IOM\2-1),DGEXC(DGI) S DGEND=1
.Q
Q
;
HINI ;Initialize header variables
S DGLINE="",$P(DGLINE,"-",133)="",DGPAGE=1,DGPG=0
S DGPNOW=$P($$FMTE^XLFDT($$NOW^XLFDT()),":",1,2)
S DGTITL="<*> Patient Name Standardization Report <*>"
Q
;
HDR(DGTY,DGNEG) ;Print header
;Input: DGTY=type of header where:
; '0'=report parameters
; '1'=detailed report
; '2'=summary report
; DGNEG='1' to indicate a negative report (optional)
N Y
Q:DGOUT
I $E(IOST)="C",DGPG N DIR S DIR(0)="E" W ! D ^DIR S DGOUT=Y'=1 Q:DGOUT
N DGX,DGP S DGP=$S($G(^XTMP("DPTNAME",0,0)):"",1:"Potential ")
D STOP Q:DGOUT
W:DGPG!($E(IOST)="C") $$XY(IOF,1,0)
W:$X $$XY("",0,0)
W DGLINE,!?(132-$L(DGTITL)\2),DGTITL
I DGTY=0 S DGX="Report Parameters for "_DGP_"Name Conversion"
I DGTY=1 S DGX="Detail of "_DGP_"Name Field Changes"
I DGTY=2 S DGX="Name Field "_DGP_"Change Statistics"
W !?(132-$L(DGX)\2),DGX
W !,DGLINE
W !,"Date printed: ",DGPNOW,?(126-$L(DGPAGE)),"Page: ",DGPAGE
W !,DGLINE
S DGPAGE=DGPAGE+1,DGPG=1
Q:'DGTY
D:DGTY=1
.W !,"Patient Name",?22,"SSN",?33,"Field"
.W ?54,"Old Name Value",?90,"New Name Value",?125,"Codes"
.Q
D:DGTY=2
.W !?26,"Field",?56,"Evaluated",?67,"Changed",?76,"Type 1"
.W ?84,"Type 2",?92,"Type 3",?100,"Type 4"
.Q
W !,DGLINE
Q
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (DGOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
XY(X,DGI,DGZ) ;Maintain $X, $Y
;Required input: X=screen handling variable
;Optional input: DGI=1 if indirection is needed
;Optional input: DGZ=0 if $X & $Y are to be zeroed
N DX,DY S DX=$X,DY=$Y S:$G(DGZ)=0 (DX,DY)=0
I $G(DGI),$L(X) W @X X ^%ZOSF("XY") Q ""
W X X ^%ZOSF("XY")
Q ""
;
TITL(DGES) ;Display report title
;Required input: DGES=report descriptive title
N X,DGX
D ENS^%ZISS S X=0 X ^%ZOSF("RM")
I $E(IOST)'="C" W $$XY(IOF,1,0),?(IOM-$L(DGES)\2),DGES,! Q
S:$L(DGES)#1 DGES=DGES_" " S IOTM=3,IOBM=IOSL,DGX=""
S $P(DGX," ",(80-$L(DGES)\2+1))="",DGX=DGX_DGES_DGX
W $$XY(IOF,1,0),$$XY(IORVON),DGX,$$XY(IORVOFF),$$XY(IOSTBM,1),!
Q
;
SUBT(DGX) ;Display subtitle
;Required input: DGX=subtitle text
W !!?(80-$L(DGX)\2),$$XY(IORVON),DGX,$$XY(IORVOFF)
Q
;
END ;Clean up
N X S X=IOM X ^%ZOSF("RM") D DISP0,KILL^%ZISS
Q
;
DISP0 ;Return to full screen scrolling
N DGRM,DGXY
Q:$E(IOST)'="C"
D ENS^%ZISS S DGRM=^%ZOSF("RM"),DGXY=^%ZOSF("XY"),(IOTM,IOBM)=0
W $$XY(IOSTBM,1),@IOF N DX,DY,X S (DX,DY)=0 X DGXY S X=IOM X DGRM
Q
;
TIME(DGX) ;Externalize run time
;Input: DGX=number of seconds
;Output: text formatted string with # days, hours, minutes and seconds
N DGY
S DGY("D")=DGX\86400
S DGX=DGX#86400,DGY("H")=DGX\3600,DGX=DGX#3600
S DGY("M")=DGX\60,DGY("S")=DGX#60
S DGY("D")=$S('DGY("D"):"",1:DGY("D")_" day"_$S(DGY("D")=1:"",1:"s")_", ")
S DGY("H")=DGY("H")_" hour"_$S(DGY("H")=1:"",1:"s")_", "
S DGY("M")=DGY("M")_" minute"_$S(DGY("M")=1:"",1:"s")_", "
S DGY("S")=DGY("S")_" second"_$S(DGY("S")=1:"",1:"s")
Q DGY("D")_DGY("H")_DGY("M")_DGY("S")
;
XRARY ;Gather xref kills and sets
N DGI,DGII,DGIEN,DGVAL,DGDATA,DGZ
S DGI="",DGVAL(1)=2,DGZ=0
F S DGZ=$O(DGFIELD(DGZ)) Q:'DGZ D
.F S DGI=$O(DGFIELD(DGZ,DGI)) Q:DGI="" D
..S DGVAL(2)=$P(DGFIELD(DGZ,DGI),U,7)
..D FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGDATA")
..S DGIEN=+DGDATA("DILIST",1,0)_"," K DGDATA
..D GETS^DIQ(.11,DGIEN,"1.1;2.1","","DGDATA")
..F DGII=1.1,2.1 S DGXRARY(DGVAL(2),DGII)=DGDATA(.11,DGIEN,DGII)
..Q
.Q
Q
DG53244V ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
+1 ;;5.3;Registration;**244,1015**;Aug 13, 1993;Build 21
+2 ;
PRT ;Do report output
+1 IF '$DATA(ZTQUEUED)
IF $EXTRACT(IOST)="C"
DO WAIT^DICD
+2 NEW DGOUT,DGLINE,DGTITL,DGPAGE,DGPG,DGNMSP,DGPNOW
+3 SET DGOUT=0
SET DGNMSP="DPTNAME"
+4 DO RUN^DG53244U(DGFLAG)
IF DGOUT
QUIT
+5 DO HINI
IF DGFMT="D"
DO GDETAIL
DO STOP
IF DGOUT
QUIT
+6 IF $EXTRACT(IOST)="C"
DO END
+7 IF DGFMT="D"
Begin DoDot:1
+8 DO HDR(0)
IF DGOUT
QUIT
DO PARAM
IF DGOUT
QUIT
+9 DO HDR(1)
IF DGOUT
QUIT
DO PDETAIL
+10 QUIT
End DoDot:1
+11 IF DGOUT
QUIT
+12 DO HDR(2)
DO STATS(0)
+13 IF DGOUT
QUIT
+14 IF $EXTRACT(IOST)="C"
NEW DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
+15 KILL DGLIM,DGFLAG,DGFMT,DGFLD,DGEXC,^TMP(DGNMSP,$JOB)
+16 QUIT
+17 ;
STATS(DGXM) ;Print statistics page
+1 ;Input: DGXM=number > 0 to set array for mailman--
+2 ; pass by reference (optional)
+3 ;
+4 NEW DGI,DGY,DGX,DGFILE,DGFLD,DGET,DGPDT,DGTOT,DGSEC
+5 SET DGXM=+$GET(DGXM)
SET (DGET,DGFILE,DGTOT,DGSEC)=0
+6 IF DGXM
Begin DoDot:1
+7 SET DGX=" "
DO SOUT
IF DGOUT
QUIT
+8 SET DGY="Patient Name Conversion Statistics"
SET DGX=""
+9 SET $EXTRACT(DGX,(80-$LENGTH(DGY)\2))=DGY
DO SOUT
IF DGOUT
QUIT
+10 SET DGX=$EXTRACT(DGLINE,1,80)
DO SOUT
IF DGOUT
QUIT
+11 SET DGX="Field"
SET $EXTRACT(DGX,30)="Evaluated"
SET $EXTRACT(DGX,41)="Changed"
+12 SET $EXTRACT(DGX,50)="Type 1"
SET $EXTRACT(DGX,58)="Type 2"
SET $EXTRACT(DGX,66)="Type 3"
+13 SET $EXTRACT(DGX,74)="Type 4"
DO SOUT
IF DGOUT
QUIT
+14 SET DGX=$EXTRACT(DGLINE,1,80)
DO SOUT
+15 QUIT
End DoDot:1
IF DGOUT
QUIT
+16 FOR
SET DGFILE=$ORDER(^XTMP(DGNMSP,"STATS",DGFILE))
IF 'DGFILE!DGOUT
QUIT
Begin DoDot:1
+17 SET DGFLD=0
+18 FOR
SET DGFLD=$ORDER(^XTMP(DGNMSP,"STATS",DGFILE,DGFLD))
IF 'DGFLD!DGOUT
QUIT
Begin DoDot:2
+19 SET DGY=^XTMP(DGNMSP,"STATS",DGFILE,DGFLD)
SET DGX=DGFILE_","_DGFLD
+20 SET $EXTRACT(DGX,10)=$PIECE(DGY,U,7)
SET $EXTRACT(DGX,30)=$JUSTIFY(+$PIECE(DGY,U),9,0)
+21 SET $EXTRACT(DGX,41)=$JUSTIFY(+$PIECE(DGY,U,2),7,0)
SET $EXTRACT(DGX,50)=$JUSTIFY(+$PIECE(DGY,U,3),6,0)
+22 SET $EXTRACT(DGX,58)=$JUSTIFY(+$PIECE(DGY,U,4),6,0)
SET $EXTRACT(DGX,66)=$JUSTIFY(+$PIECE(DGY,U,5),6,0)
+23 SET $EXTRACT(DGX,74)=$JUSTIFY(+$PIECE(DGY,U,6),6,0)
SET DGET=DGET+$PIECE(DGY,U)
+24 DO SOUT
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
+27 IF DGOUT
QUIT
SET DGX=$EXTRACT(DGLINE,1,80)
+28 DO SOUT
IF DGOUT
QUIT
+29 SET DGY=^XTMP(DGNMSP,"STATS")
+30 SET DGX="REPORT TOTAL:"
SET $EXTRACT(DGX,30)=$JUSTIFY(DGET,9,0)
+31 SET $EXTRACT(DGX,41)=$JUSTIFY(+$PIECE(DGY,U,3),7,0)
SET $EXTRACT(DGX,50)=$JUSTIFY(+$PIECE(DGY,U,4),6,0)
+32 SET $EXTRACT(DGX,58)=$JUSTIFY(+$PIECE(DGY,U,5),6,0)
SET $EXTRACT(DGX,66)=$JUSTIFY(+$PIECE(DGY,U,6),6,0)
+33 SET $EXTRACT(DGX,74)=$JUSTIFY(+$PIECE(DGY,U,7),6,0)
+34 DO SOUT
IF DGOUT
QUIT
SET DGX=" "
DO SOUT
IF DGOUT
QUIT
SET DGX=""
+35 SET $EXTRACT(DGX,10)="Exception types: 1 Name value contains no comma"
+36 DO SOUT
IF DGOUT
QUIT
SET DGX=""
+37 SET $EXTRACT(DGX,27)="2 Parenthetical text is removed from name"
+38 DO SOUT
IF DGOUT
QUIT
SET DGX=""
+39 SET $EXTRACT(DGX,27)="3 Name value cannot be converted"
+40 DO SOUT
IF DGOUT
QUIT
SET DGX=""
+41 SET $EXTRACT(DGX,27)="4 Characters are removed or changed"
+42 DO SOUT
IF DGOUT
QUIT
SET DGX=" "
DO SOUT
IF DGOUT
QUIT
SET DGX=""
+43 SET $EXTRACT(DGX,24)="Total name values evaluated: "_$JUSTIFY(+DGY,7,0)
+44 DO SOUT
IF DGOUT
QUIT
SET DGX=""
+45 SET $EXTRACT(DGX,20)="Total patient records to change: "_$JUSTIFY(+$PIECE(DGY,U,2),7,0)
+46 DO SOUT
IF DGOUT
QUIT
+47 SET DGPDT=$GET(^XTMP(DGNMSP,0,0))
IF 'DGPDT
QUIT
+48 SET DGX=" "
DO SOUT
SET DGX=""
IF DGOUT
QUIT
+49 SET $EXTRACT(DGX,12)="Name conversion processing started "_$$FMTE^XLFDT(+DGPDT)
+50 DO SOUT
SET DGX=""
IF DGOUT
QUIT
+51 IF $PIECE(DGPDT,U,2)
Begin DoDot:1
+52 SET $EXTRACT(DGX,12)="Name conversion processing completed "_$$FMTE^XLFDT($PIECE(DGPDT,U,2))
+53 DO SOUT
QUIT
End DoDot:1
IF DGOUT
QUIT
+54 SET DGX=" "
DO SOUT
IF DGOUT
QUIT
+55 SET DGI=0
FOR
SET DGI=$ORDER(^XTMP(DGNMSP,0,DGI))
IF 'DGI!DGOUT
QUIT
Begin DoDot:1
+56 SET DGY=^XTMP(DGNMSP,0,DGI)
SET DGX=""
+57 SET $EXTRACT(DGX,1)=DGI_". "_$$FMTE^XLFDT($PIECE(DGY,U))
+58 IF $PIECE(DGY,U,2)
Begin DoDot:2
+59 SET DGX=DGX_" to "_$$FMTE^XLFDT($PIECE(DGY,U,2))
+60 SET DGSEC=DGSEC+$$FMDIFF^XLFDT($PIECE(DGY,U,2),$PIECE(DGY,U),2)
End DoDot:2
+61 IF $PIECE(DGY,U,4)
Begin DoDot:2
+62 SET DGX=DGX_", names processed: "_($PIECE(DGY,U,4)-$PIECE(DGY,U,3))
+63 SET DGTOT=DGTOT+($PIECE(DGY,U,4)-$PIECE(DGY,U,3))
+64 QUIT
End DoDot:2
+65 DO SOUT
+66 QUIT
End DoDot:1
+67 IF 'DGSEC!DGOUT
QUIT
+68 SET DGX=" "
DO SOUT
IF DGOUT
QUIT
+69 SET DGY="Processing time: "_$$TIME(DGSEC)
+70 SET DGX=""
SET $EXTRACT(DGX,(80-$LENGTH(DGY)\2))=DGY
+71 DO SOUT
IF 'DGTOT!DGOUT
QUIT
+72 SET DGY="Processing rate: "_(DGTOT\(DGSEC/3600))_" name values per hour"
+73 SET DGX=""
SET $EXTRACT(DGX,(80-$LENGTH(DGY)\2))=DGY
DO SOUT
+74 QUIT
+75 ;
SOUT ;Output statistics line
+1 IF DGXM
SET DGXM=DGXM+1
SET DGXM(DGXM,0)=DGX
QUIT
+2 IF $Y>(IOSL-3)
DO HDR(2)
IF DGOUT
QUIT
WRITE !?26,DGX
+3 QUIT
+4 ;
GDETAIL ;Generate report detail global
+1 KILL ^TMP(DGNMSP,$JOB)
+2 NEW DGNAME,DFN,DGFILE,DGIFN,DGFIELD,DGX,DGTYPE,DGSSN
+3 SET DGNAME=""
+4 FOR
SET DGNAME=$ORDER(^XTMP(DGNMSP,"B",DGNAME))
IF DGNAME=""
QUIT
SET DFN=0
Begin DoDot:1
+5 FOR
SET DFN=$ORDER(^XTMP(DGNMSP,"B",DGNAME,DFN))
IF 'DFN
QUIT
SET DGFILE=0
Begin DoDot:2
+6 SET DGSSN=$PIECE($GET(^DPT(DFN,0)),U,9)
+7 FOR
SET DGFILE=$ORDER(^XTMP(DGNMSP,DFN,DGFILE))
IF 'DGFILE
QUIT
SET DGIFN=0
Begin DoDot:3
+8 FOR
SET DGIFN=$ORDER(^XTMP(DGNMSP,DFN,DGFILE,DGIFN))
IF 'DGIFN
QUIT
Begin DoDot:4
+9 SET DGFIELD=0
+10 FOR
SET DGFIELD=$ORDER(^XTMP(DGNMSP,DFN,DGFILE,DGIFN,DGFIELD))
IF 'DGFIELD
QUIT
Begin DoDot:5
+11 IF '$$OKFLD(DGFILE,DGFIELD)
QUIT
+12 SET DGX=^XTMP(DGNMSP,DFN,DGFILE,DGIFN,DGFIELD)
SET DGTYPE=$PIECE(DGX,U,3)
+13 IF '$$OKTYP(DGTYPE)
QUIT
+14 SET ^TMP(DGNMSP,$JOB,DGNAME,DFN,DGFILE,DGIFN,DGFIELD)=DGSSN_U_DGX
+15 QUIT
End DoDot:5
+16 QUIT
End DoDot:4
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
PDETAIL ;Print report detail
+1 NEW DGNAME,DFN,DGFILE,DGIFN,DGFIELD,DGX,DGR
+2 SET (DGR,DGNAME)=""
+3 FOR
SET DGNAME=$ORDER(^TMP(DGNMSP,$JOB,DGNAME))
IF DGNAME=""!DGOUT
QUIT
SET DFN=0
Begin DoDot:1
+4 FOR
SET DFN=$ORDER(^TMP(DGNMSP,$JOB,DGNAME,DFN))
IF 'DFN!DGOUT
QUIT
SET DGFILE=0
Begin DoDot:2
+5 FOR
SET DGFILE=$ORDER(^TMP(DGNMSP,$JOB,DGNAME,DFN,DGFILE))
IF 'DGFILE!DGOUT
QUIT
Begin DoDot:3
+6 SET DGIFN=0
+7 FOR
SET DGIFN=$ORDER(^TMP(DGNMSP,$JOB,DGNAME,DFN,DGFILE,DGIFN))
IF 'DGIFN!DGOUT
QUIT
Begin DoDot:4
+8 SET DGFIELD=0
+9 FOR
SET DGFIELD=$ORDER(^TMP(DGNMSP,$JOB,DGNAME,DFN,DGFILE,DGIFN,DGFIELD))
IF 'DGFIELD!DGOUT
QUIT
Begin DoDot:5
+10 SET DGX=^TMP(DGNMSP,$JOB,DGNAME,DFN,DGFILE,DGIFN,DGFIELD)
+11 IF $Y>(IOSL-3)
DO HDR(1)
IF DGOUT
QUIT
+12 WRITE !
IF DGR'=DFN
WRITE $EXTRACT(DGNAME,1,20),?22,$PIECE(DGX,U)
SET DGR=DFN
+13 WRITE ?33,$PIECE(^XTMP(DGNMSP,"STATS",DGFILE,DGFIELD),U,7)
+14 WRITE ?54,$PIECE(DGX,U,2),?90,$PIECE(DGX,U,3),?125,$$EXC($PIECE(DGX,U,4))
+15 QUIT
End DoDot:5
+16 QUIT
End DoDot:4
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
EXC(DGE) ;Format exception types with commas
+1 NEW DGI,DGX
SET DGX=""
+2 FOR DGI=1:1:$LENGTH(DGE)
SET DGX=DGX_$EXTRACT(DGE,DGI)_","
+3 QUIT $EXTRACT(DGX,1,($LENGTH(DGX)-1))
+4 ;
OKFLD(DGFILE,DGFIELD) ;Check field screen
+1 IF DGFLD="A"
QUIT 1
+2 IF DGFIELD=.01
QUIT ($DATA(DGFLD(DGFIELD))&(DGFILE=2))
+3 IF DGFILE=2.01
QUIT $DATA(DGFLD(DGFILE))
+4 IF $DATA(DGFLD(DGFIELD))
QUIT 1
+5 IF $DATA(DGFLD(DGFILE))
QUIT 1
+6 QUIT 0
+7 ;
OKTYP(DGTYPE) ;Check exception types
+1 NEW DGI,DGOK
SET (DGI,DGOK)=0
+2 FOR
IF DGOK
QUIT
SET DGI=$ORDER(DGEXC(DGI))
IF 'DGI
QUIT
IF DGTYPE[DGI
SET DGOK=1
+3 QUIT DGOK
+4 ;
PARAM NEW DGEND
SET DGEND=0
+1 WRITE !!?(IOM\2-25),"The following report parameters have been selected:"
+2 WRITE !!?(IOM\2-28),"Report generation action: ",DGFLAG(DGFLAG)
+3 WRITE !?(IOM\2-28)," Report format: ",DGFMT(DGFMT)
+4 WRITE !?(IOM\2-28)," Fields to return:"
SET DGEND=0
+5 SET DGI=""
FOR
SET DGI=$ORDER(DGFLD(DGI))
IF DGI=""
QUIT
Begin DoDot:1
+6 IF DGEND
WRITE !
WRITE ?(IOM\2-1),DGFLD(DGI)
SET DGEND=1
+7 QUIT
End DoDot:1
+8 WRITE !?(IOM\2-28)," Exceptions to report:"
SET DGEND=0
+9 SET DGI=""
FOR
SET DGI=$ORDER(DGEXC(DGI))
IF DGI=""
QUIT
Begin DoDot:1
+10 IF DGEND
WRITE !
WRITE ?(IOM\2-1),DGEXC(DGI)
SET DGEND=1
+11 QUIT
End DoDot:1
+12 QUIT
+13 ;
HINI ;Initialize header variables
+1 SET DGLINE=""
SET $PIECE(DGLINE,"-",133)=""
SET DGPAGE=1
SET DGPG=0
+2 SET DGPNOW=$PIECE($$FMTE^XLFDT($$NOW^XLFDT()),":",1,2)
+3 SET DGTITL="<*> Patient Name Standardization Report <*>"
+4 QUIT
+5 ;
HDR(DGTY,DGNEG) ;Print header
+1 ;Input: DGTY=type of header where:
+2 ; '0'=report parameters
+3 ; '1'=detailed report
+4 ; '2'=summary report
+5 ; DGNEG='1' to indicate a negative report (optional)
+6 NEW Y
+7 IF DGOUT
QUIT
+8 IF $EXTRACT(IOST)="C"
IF DGPG
NEW DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
SET DGOUT=Y'=1
IF DGOUT
QUIT
+9 NEW DGX,DGP
SET DGP=$SELECT($GET(^XTMP("DPTNAME",0,0)):"",1:"Potential ")
+10 DO STOP
IF DGOUT
QUIT
+11 IF DGPG!($EXTRACT(IOST)="C")
WRITE $$XY(IOF,1,0)
+12 IF $X
WRITE $$XY("",0,0)
+13 WRITE DGLINE,!?(132-$LENGTH(DGTITL)\2),DGTITL
+14 IF DGTY=0
SET DGX="Report Parameters for "_DGP_"Name Conversion"
+15 IF DGTY=1
SET DGX="Detail of "_DGP_"Name Field Changes"
+16 IF DGTY=2
SET DGX="Name Field "_DGP_"Change Statistics"
+17 WRITE !?(132-$LENGTH(DGX)\2),DGX
+18 WRITE !,DGLINE
+19 WRITE !,"Date printed: ",DGPNOW,?(126-$LENGTH(DGPAGE)),"Page: ",DGPAGE
+20 WRITE !,DGLINE
+21 SET DGPAGE=DGPAGE+1
SET DGPG=1
+22 IF 'DGTY
QUIT
+23 IF DGTY=1
Begin DoDot:1
+24 WRITE !,"Patient Name",?22,"SSN",?33,"Field"
+25 WRITE ?54,"Old Name Value",?90,"New Name Value",?125,"Codes"
+26 QUIT
End DoDot:1
+27 IF DGTY=2
Begin DoDot:1
+28 WRITE !?26,"Field",?56,"Evaluated",?67,"Changed",?76,"Type 1"
+29 WRITE ?84,"Type 2",?92,"Type 3",?100,"Type 4"
+30 QUIT
End DoDot:1
+31 WRITE !,DGLINE
+32 QUIT
+33 ;
STOP ;Check for stop task request
+1 IF $DATA(ZTQUEUED)
SET (DGOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
XY(X,DGI,DGZ) ;Maintain $X, $Y
+1 ;Required input: X=screen handling variable
+2 ;Optional input: DGI=1 if indirection is needed
+3 ;Optional input: DGZ=0 if $X & $Y are to be zeroed
+4 NEW DX,DY
SET DX=$X
SET DY=$Y
IF $GET(DGZ)=0
SET (DX,DY)=0
+5 IF $GET(DGI)
IF $LENGTH(X)
WRITE @X
XECUTE ^%ZOSF("XY")
QUIT ""
+6 WRITE X
XECUTE ^%ZOSF("XY")
+7 QUIT ""
+8 ;
TITL(DGES) ;Display report title
+1 ;Required input: DGES=report descriptive title
+2 NEW X,DGX
+3 DO ENS^%ZISS
SET X=0
XECUTE ^%ZOSF("RM")
+4 IF $EXTRACT(IOST)'="C"
WRITE $$XY(IOF,1,0),?(IOM-$LENGTH(DGES)\2),DGES,!
QUIT
+5 IF $LENGTH(DGES)#1
SET DGES=DGES_" "
SET IOTM=3
SET IOBM=IOSL
SET DGX=""
+6 SET $PIECE(DGX," ",(80-$LENGTH(DGES)\2+1))=""
SET DGX=DGX_DGES_DGX
+7 WRITE $$XY(IOF,1,0),$$XY(IORVON),DGX,$$XY(IORVOFF),$$XY(IOSTBM,1),!
+8 QUIT
+9 ;
SUBT(DGX) ;Display subtitle
+1 ;Required input: DGX=subtitle text
+2 WRITE !!?(80-$LENGTH(DGX)\2),$$XY(IORVON),DGX,$$XY(IORVOFF)
+3 QUIT
+4 ;
END ;Clean up
+1 NEW X
SET X=IOM
XECUTE ^%ZOSF("RM")
DO DISP0
DO KILL^%ZISS
+2 QUIT
+3 ;
DISP0 ;Return to full screen scrolling
+1 NEW DGRM,DGXY
+2 IF $EXTRACT(IOST)'="C"
QUIT
+3 DO ENS^%ZISS
SET DGRM=^%ZOSF("RM")
SET DGXY=^%ZOSF("XY")
SET (IOTM,IOBM)=0
+4 WRITE $$XY(IOSTBM,1),@IOF
NEW DX,DY,X
SET (DX,DY)=0
XECUTE DGXY
SET X=IOM
XECUTE DGRM
+5 QUIT
+6 ;
TIME(DGX) ;Externalize run time
+1 ;Input: DGX=number of seconds
+2 ;Output: text formatted string with # days, hours, minutes and seconds
+3 NEW DGY
+4 SET DGY("D")=DGX\86400
+5 SET DGX=DGX#86400
SET DGY("H")=DGX\3600
SET DGX=DGX#3600
+6 SET DGY("M")=DGX\60
SET DGY("S")=DGX#60
+7 SET DGY("D")=$SELECT('DGY("D"):"",1:DGY("D")_" day"_$SELECT(DGY("D")=1:"",1:"s")_", ")
+8 SET DGY("H")=DGY("H")_" hour"_$SELECT(DGY("H")=1:"",1:"s")_", "
+9 SET DGY("M")=DGY("M")_" minute"_$SELECT(DGY("M")=1:"",1:"s")_", "
+10 SET DGY("S")=DGY("S")_" second"_$SELECT(DGY("S")=1:"",1:"s")
+11 QUIT DGY("D")_DGY("H")_DGY("M")_DGY("S")
+12 ;
XRARY ;Gather xref kills and sets
+1 NEW DGI,DGII,DGIEN,DGVAL,DGDATA,DGZ
+2 SET DGI=""
SET DGVAL(1)=2
SET DGZ=0
+3 FOR
SET DGZ=$ORDER(DGFIELD(DGZ))
IF 'DGZ
QUIT
Begin DoDot:1
+4 FOR
SET DGI=$ORDER(DGFIELD(DGZ,DGI))
IF DGI=""
QUIT
Begin DoDot:2
+5 SET DGVAL(2)=$PIECE(DGFIELD(DGZ,DGI),U,7)
+6 DO FIND^DIC(.11,"","@;IXIE","KP",.DGVAL,"","","","","DGDATA")
+7 SET DGIEN=+DGDATA("DILIST",1,0)_","
KILL DGDATA
+8 DO GETS^DIQ(.11,DGIEN,"1.1;2.1","","DGDATA")
+9 FOR DGII=1.1,2.1
SET DGXRARY(DGVAL(2),DGII)=DGDATA(.11,DGIEN,DGII)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
