Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53244V

DG53244V.m

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