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

DG53244T.m

Go to the documentation of this file. 
  1. DG53244T ;BPOIFO/KEITH - NAME STANDARDIZATION ; 27 Jan 2002 11:05 PM
  1.  ;;5.3;Registration;**244,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. PRINT ;Print name conversion report
  1.  ;
  1.  N DGFLAG,DGPDT,DGOUT,DTOUT,DUOUT
  1.  N DIR,DGEND,DGFMT,DGFLD,DGEXC,DGI,DGT0
  1.  D TITL^DG53244V("Patient Name Standardization Report") S (DGEND,DGOUT)=0
  1.  S DGT0=$D(^XTMP("DPTNAME",0)),DGPDT=$G(^XTMP("DPTNAME",0,0))
  1.  I 'DGT0 D
  1.  .W !!,"The patient name conversion report global has not been created.  A report"
  1.  .W !,"global will be generated which can be reprinted later."
  1.  .S DGFLAG="K",DGFLAG("K")="Kill the global and regenerate"
  1.  .Q
  1.  I DGT0 D
  1.  .I DGPDT D
  1.  ..W !!,"Name conversion processing started on ",$$FMTE^XLFDT(+DGPDT) W:'$P(DGPDT,U,2) " but has not completed."
  1.  ..W:$P(DGPDT,U,2) " and completed ",!,$$FMTE^XLFDT($P(DGPDT,U,2)),"."
  1.  ..S DGFLAG="U",DGFLAG("U")="Use the existing report global"
  1.  ..Q
  1.  .I 'DGPDT D
  1.  ..W !!,"Name conversion processing doesn't appear to have been performed."
  1.  ..D SUBT^DG53244V("*** Report Generation Action ***")
  1.  ..W !!,"A name conversion report global already exists, you may use it or regenerate",!,"the information.",!
  1.  ..K DIR
  1.  ..S DIR(0)="S^U:Use the existing report global;K:Kill the global and regenerate"
  1.  ..S DIR("A")="Report generation action"
  1.  ..D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  ..S DGFLAG=Y,DGFLAG(Y)=Y(0)
  1.  ..Q
  1.  .Q
  1.  G:DGOUT Q
  1.  D SUBT^DG53244V("*** Report Output Format ***")
  1.  K DIR
  1.  S DIR(0)="S^S:Statistics only;D:Detailed report",DIR("A")="Report format",DIR("?")="Specify if the report should return a list of name exceptions or statistics only."
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT) G Q
  1.  S DGFMT=Y,DGFMT(DGFMT)=Y(0) G:DGFMT="S" QUEUE
  1.  D SUBT^DG53244V("*** Conversion Fields to Include ***")
  1.  W !!,"The name conversion ",$S(DGPDT:"has changed",1:"will change")," data in eleven different PATIENT file fields.",!,"Please specify which of these fields to return on the report."
  1. FLDS ;Get fields to report
  1.  K DIR
  1.  S DIR(0)="SO^A:All fields;.01:Patient name;.211:K Name;.2191:K2 Name;.2401:Father's name;.2402:Mother's name;.2403:Mother's maiden name;.331:E Name;.3311:E2 Name;.341:D Name;2.01:Alias;2.101:Attorney's Name"
  1.  S DIR("A")="Select field to include",DGFLD="",DIR("B")="All fields"
  1.  F  D  Q:DGOUT!DGEND
  1.  .D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  .I X="" S DGEND=1 Q
  1.  .S DIR("A")="Select another field to include" K DIR("B")
  1.  .I Y="A" K DGFLD S DGFLD="A",DGFLD(Y)=Y(0),DGEND=1 Q
  1.  .S DGFLD(Y)=Y(0) N DGX
  1.  .S DGX=";"_Y_":"_Y(0),DIR(0)=$P(DIR(0),DGX)_$P(DIR(0),DGX,2)
  1.  .Q
  1.  G:DGOUT Q
  1.  I $D(DGFLD)<10 W !!,$C(7),"At least one selection is required!",! G FLDS
  1.  D SUBT^DG53244V("*** Name Exceptions to Include ***")
  1.  W !!,"This report groups name exceptions by the categories listed below.  Of these"
  1.  W !,"types, the first three are considered important to review.  Names with no comma"
  1.  W !,"may not be parsed correctly by Kernel name standardization utilities.  Names"
  1.  W !,"with parenthetical text, e.g. ""(INELIGIBLE)"" may require clean up prior to"
  1.  W !,"conversion.  Names that cannot be converted should be corrected or deleted."
  1.  W !!,"The fourth category will apply to the majority of name changes.  These are"
  1.  W !,"instances where characters such as periods, have been removed or changed"
  1.  W !," and probably do not require review.  You may review all four categories but"
  1.  W !,"limiting the report to the first three will produce a more relevant and"
  1.  W !,"manageable list."
  1.  K DIR
  1.  S DIR(0)="SO^1:Name value contains no comma;2:Parenthetical text is removed from name;3:Name value cannot be converted;4:Characters are removed or changed"
  1.  S DIR("A")="Select an exception to include",DGEND=0
  1. EXC F  D  Q:DGOUT!DGEND
  1.  .D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  .I X="" S DGEND=1 Q
  1.  .S DGEXC(Y)=Y(0)
  1.  .I $D(DGEXC(1)),$D(DGEXC(2)),$D(DGEXC(3)),$D(DGEXC(4)) D  Q
  1.  ..S DGEND=1,DGEXC="ALL" Q
  1.  .S DIR("A")="Select another exception to include" N DGX
  1.  .S DGX=Y_":"_Y(0),DIR(0)=$P(DIR(0),DGX)_$P(DIR(0),DGX,2)
  1.  .I DIR(0)[";;" S DIR(0)=$P(DIR(0),";;")_";"_$P(DIR(0),";;",2)
  1.  .Q
  1.  G:DGOUT Q
  1.  I $D(DGEXC)<10 W !!,$C(7),"At least one selection is required!",! G EXC
  1.  ;
  1.  D SUBT^DG53244V("*** Selected Report Parameters ***")
  1.  D PARAM^DG53244V
  1.  K DIR S DIR(0)="Y",DIR("A")="Ok",DIR("B")="YES",DIR("?")="Indicate if the selected parameters are correct."
  1.  D ^DIR G:'Y!$D(DTOUT)!$D(DUOUT) Q
  1. QUEUE W !!,$C(7),"This report requires 132 column output!"
  1.  F DGI="DGFLAG","DGFLAG(","DGFMT","DGFMT(","DGFLD","DGFLD(","DGEXC","DGEXC(" S ZTSAVE(DGI)=""
  1.  D EN^XUTMDEVQ("PRT^DG53244V","Print Patient Name Standardization Report",.ZTSAVE)
  1. Q D END^DG53244V Q
  1.  ;
  1. CONVERT ;Convert patient name fields
  1.  N DGOUT,DGEND,DGPDT,DGRUN,DGT0,DGI,DIR,DTOUT,DUOUT,DGLIM,DGFLAG
  1.  S DGOUT=0,DGFLAG="P",DGFLAG(DGFLAG)="Process patient name conversion"
  1.  D TITL^DG53244V("*** Patient Name Field Conversion ***")
  1.  S DGPDT=$G(^XTMP("DPTNAME",0,0)),DGT0=$G(^XTMP("DPTNAME",0))
  1.  S DGRUN=($P(DGT0,U,5)="RUN")
  1.  I DGPDT D
  1.  .W !!,"Name conversion processing started on ",$$FMTE^XLFDT(+DGPDT) W:'$P(DGPDT,U,2) " but has not completed."
  1.  .W:$P(DGPDT,U,2) " and completed ",!,$$FMTE^XLFDT($P(DGPDT,U,2)),"."
  1.  .Q
  1.  I $P(DGPDT,U,2) D  G Q
  1.  .W !!,$C(7),"It appears that the conversion of patient name fields has completed.  No"
  1.  .W !,"further action should be necessary.  To review the results of the conversion,"
  1.  .W !,"a report may be printed with the PRINT^DG53244T entry point."
  1.  .S DIR(0)="E",DIR("A")="Enter RETURN to exit"
  1.  .W !! D ^DIR
  1.  .Q
  1.  I DGRUN D  G Q:DGOUT
  1.  .W !!,"It appears that the conversion of patient name fields is running currently."
  1.  .F DGI=1:1:10 Q:DGOUT  D
  1.  ..I $P(^XTMP("DPTNAME",0),U,4)'=$P(DGT0,U,4) S DGOUT=1 Q
  1.  ..H 1 W "." Q
  1.  .I DGOUT D  Q
  1.  ..W !!,"An additional processing task should not be started at this time.",!
  1.  ..S DIR(0)="E",DIR("A")="Enter RETURN to exit"
  1.  ..W !! D ^DIR
  1.  ..Q
  1.  .S $P(^XTMP("DPTNAME",0),U,5)="STOP"
  1.  .W "that process has been flagged to stop."
  1.  I 'DGPDT D
  1.  .W !!,"Name conversion processing doesn't appear to have been performed."
  1.  .Q
  1. LIM D SUBT^DG53244V("*** Processing Limitation ***")
  1.  S DGI="Processing will "_$S(DGPDT:"continue",1:"begin")_" with PATIENT file entry "_$S(DGPDT:$P(DGT0,U,4)+1,1:$O(^DPT(0)))_"."
  1.  W !!?(80-$L(DGI)\2),DGI
  1.  W !!,"The conversion can be tasked to run to completion or stop after a specified"
  1.  W !,"record entry or date/time.  If stopped prior to completion it will need to be"
  1.  W !,"re-tasked to run to completion at another time."
  1.  S DIR(0)="S^R:Run to completion;SR:Stop after specified record;SD:Stop after date/time"
  1.  S DIR("A")="Specify processing limitation"
  1.  D ^DIR I $D(DTOUT)!$D(DUOUT) G Q
  1.  S DGLIM=Y
  1. SR I DGLIM="SR" D  G:DGOUT Q
  1.  .D SUBT^DG53244V("*** Specify Ending Record ***")
  1.  .W !!,"Name conversion processing will discontinue after the record number specified."
  1.  .S DIR(0)="N^"_$S(DGPDT:(+$P(DGT0,U,4)+1),1:$O(^DPT(0)))_":"_$O(^DPT(999999999),-1)
  1.  .S DIR("A")="Record number to end processing"
  1.  .W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  .S DGLIM(DGLIM)=Y
  1.  .Q
  1. SD I DGLIM="SD" D  G:DGOUT Q
  1.  .D SUBT^DG53244V("*** Specify Ending Date/Time ***")
  1.  .W !!,"The value specified must include both date and time.  It must be at least one"
  1.  .W !,"hour in the future but not more than seven days in the future."
  1.  .S DIR(0)=$$FMADD^XLFDT($P($$NOW^XLFDT(),":",1,2),,1)_":"_$$FMADD^XLFDT($P($$NOW^XLFDT(),":",1,2),7,1)_":ET"
  1.  .S DGI="("_$$FMTE^XLFDT($P(DIR(0),":"))_" / "_$$FMTE^XLFDT($P(DIR(0),":",2))_")"
  1.  .W !!?(80-$L(DGI)\2),DGI
  1.  .S DIR("A")="Date/time to end processing: "
  1.  .S DIR(0)="DA^"_DIR(0)
  1.  .W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  .S DGLIM(DGLIM)=Y
  1.  .Q
  1.  ;
  1. PQUE ;Queue patient name conversion
  1.  D SUBT^DG53244V("*** Queue Name Conversion Processing ***")
  1.  N %DT,DGI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
  1.  S Y=DT_.22 X ^DD("DD") S %DT("B")=Y,%DT("A")="Queue to run: "
  1. PQ S %DT="AEFXR" W ! D ^%DT
  1.  I DGLIM="SD",Y>DGLIM(DGLIM) D  G PQ
  1.  .W !,$C(7),"Task start time must be earlier than processing end time!"
  1.  .Q
  1.  I Y<1 G QQ
  1.  S ZTDTH=Y,ZTRTN="RUN^DG53244U(.DGFLAG)",ZTIO=""
  1.  F DGI="DGFLAG","DGFLAG(","DGLIM","DGLIM(" S ZTSAVE(DGI)=""
  1.  S ZTDESC="Process patient name conversion"
  1.  F DGI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
  1. QQ W:'$G(ZTSK) !!,"Extract not queued!!!",!
  1.  W:$G(ZTSK) !!,"Task number: ",ZTSK,!
  1.  S DIR(0)="E",DIR("A")="Enter RETURN to exit" K DIR("B")
  1.  W !! D ^DIR
  1.  G Q
  1.  ;
  1. STOP ;Request patient name conversion to stop
  1.  N DIR,DTOUT,DUOUT,X,Y,DGRUN,DGOUT S DGOUT=0
  1.  D TITL^DG53244V("*** Stop Patient Name Conversion Process ***")
  1.  S DGRUN=($P($G(^XTMP("DPTNAME",0)),U,5)="RUN")
  1.  I 'DGRUN D
  1.  .W !!,"The patient name conversion process doesn't appear to be running currently."
  1.  .Q
  1.  I DGRUN D
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .S DIR("A")="Are you sure you wish to stop the patient name conversion process"
  1.  .D ^DIR I $D(DTOUT)!$D(DUOUT) S DGOUT=1 Q
  1.  .Q:'Y
  1.  .S $P(^XTMP("DPTNAME",0),U,5)="STOP"
  1.  .W !!,"The process has been flagged to stop."
  1.  .Q
  1.  G:DGOUT Q
  1.  S DIR(0)="E",DIR("A")="Enter RETURN to exit" K DIR("B")
  1.  W !! D ^DIR
  1.  G Q
  1.  ;
  1. MGOUT(DGNCMG) ;Remove name change mail group
  1.  ;Input: DGNCMG=variable to store existing group (pass by reference)
  1.  ;
  1.  N DGFDA,DGMSG
  1.  S DGNCMG=$P($G(^DG(43,1,"NOT")),U,3)
  1.  S:DGNCMG $P(^XTMP(DGNMSP,0),U,6)=DGNCMG
  1.  S DGFDA(43,"1,",502)="@"
  1.  D FILE^DIE("E","DGFDA","DGMSG")
  1.  Q
  1.  ;
  1. MGIN(DGNCMG) ;Replace name change mail group
  1.  ;Input: DGNCMG=mail group pointer
  1.  ;
  1.  I '$G(DGNCMG) S DGNCMG=$P(^XTMP(DGNMSP,0),U,6) Q:'DGNCMG
  1.  N DGFDA,DGMSG
  1.  S DGFDA(43,"1,",502)=DGNCMG
  1.  D FILE^DIE("","DGFDA","DGMSG")
  1.  Q