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

EASXDR.m

Go to the documentation of this file.
  1. EASXDR ;ALB/BRM - ROUTINE TO MERGE ENTRIES DURING PATIENT MERGE; ; 5/10/02 9:27am
  1. ;;1.0;ENROLLMENT APPLICATION SYSTEM;**10**;Mar 15, 2001
  1. ;
  1. EN(ARRAY) ;Entry point called with the name of the array containing the
  1. ; from and to pointers of the record being merged. The array is
  1. ; formatted as follows:
  1. ; ARRAY(FROM_IEN,TO_IEN,"FROM_IEN;DPT(","TO_IEN;DPT(")=""
  1. ;
  1. ; The code in this routine will prevent duplicate dependent entries
  1. ; from being created when the from and to records are the same
  1. ;
  1. N EASARY,IEN,DFNFR,DFNTO,IENFR,IENTO,OKTOMRG
  1. F DFNFR=0:0 S DFNFR=$O(@ARRAY@(DFNFR)) Q:$G(DFNFR)'>0 D
  1. .S DFNTO=$O(@ARRAY@(DFNFR,0))
  1. .S IENFR=$O(@ARRAY@(DFNFR,DFNTO,0))
  1. .S IENTO=$O(@ARRAY@(DFNFR,DFNTO,IENFR,0))
  1. .;attempt to merge relation entries
  1. .S OKTOMRG=$$CHKRELAT^EASXDR1(DFNFR,DFNTO,1)
  1. Q
  1. OPTION ; entry point from 'Fix Duplicate Patient Relations' menu option
  1. N DTOUT,DUOUT,DIRUT,DIROUT,DA,DIR,DIC,X,Y,DFN,DGMSGF,SSN,VETNAM
  1. S DGMSGF=1
  1. S DIR(0)="408.12,.03"
  1. S DIR("A")="Select Patient SSN"
  1. S DIR("?")="Select the SSN of the patient whose Patient Relation entries should be merged."
  1. D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
  1. W !
  1. I '+Y W !?2,Y(0)," Cannot be merged. Please select a new entry."
  1. I $P(Y,";",2)["DGPR(408.13," D G:'$D(DFN) OPTION
  1. .I '$D(^DGPR(408.12,"C",Y)) W !?2,Y(0)," Cannot be merged. Please select a new entry." Q
  1. .S IEN12=$O(^DGPR(408.12,"C",Y,""))
  1. .S DFN=$P($G(^DGPR(408.12,IEN12,0)),"^")
  1. .S VETNAM=$P($G(^DPT(DFN,0)),"^")
  1. .S SSN=$P($G(^DPT(DFN,0)),"^",9)
  1. .W !?2,Y(0)," is not in the Patient (#2) file."
  1. .W !!?2,"The following patient must be used to merge this entry:"
  1. .W !?2,"SSN:",SSN,?20,"Patient Name:",VETNAM,!!
  1. .K DIR,Y
  1. .S DIR(0)="Y",DIR("B")="YES"
  1. .S DIR("A")="Would you like to continue this merge using "_VETNAM
  1. .S DIR("?",1)="Answer 'YES' if you would like to continue the merge process"
  1. .S DIR("?",2)="using the displayed patient. This will merge all duplicate"
  1. .S DIR("?")="Patient Relations associated with the selected patient."
  1. .D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
  1. .I 'Y K DFN Q
  1. .S Y=DFN
  1. S DFN=+Y
  1. S MSG=$$CHKRELAT^EASXDR1(DFN,DFN,0)
  1. I 'MSG W !?2,"No Patient Relation entries were merged for this patient.",!! G OPTION
  1. W !?2,+MSG_" Patient Relation "_$S(+MSG=1:"entry was",1:"entries were")_" successfully merged."
  1. W !!?2,"Data deleted during this merge will be stored for 10 days"
  1. W !?2,"in the following global: ^XTMP(""EASXDR1"",""DATA"","_DFN_")",!!
  1. G OPTION
  1. Q
  1. CHGACT(MRGFRIEN,MRGTOIEN,EFFDT) ;
  1. N DIE,DIR,DIRUT,DTOUT,DUOUT,DIROUT,DIC,DA,DR,DIQ,X,Y,SSNFR,SSNTO
  1. N ACTIVE
  1. ; display data about each record
  1. D FINDSSN(MRGFRIEN,.SSNFR),FINDSSN(MRGTOIEN,.SSNTO)
  1. W:SSNFR'="" !!,"SSN:"_SSNFR
  1. S DIC="^DGPR(408.12,",DA=MRGFRIEN,DIQ(0)="R" D EN^DIQ
  1. W:SSNTO'="" !,"SSN:"_SSNTO
  1. S DIC="^DGPR(408.12,",DA=MRGTOIEN,DIQ(0)="R" D EN^DIQ
  1. ; ask user to enter the correct active flag for this date
  1. S DIR(0)="Y"
  1. S DIR("A")="Should the active flag be 'YES' or 'NO' for "_$$FMTE^XLFDT($G(EFFDT))
  1. D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
  1. S ACTIVE=Y
  1. N IEN12,SUBIEN,ACTROOT,FDA,DIERR
  1. F IEN12=MRGFRIEN,MRGTOIEN D
  1. .S ACTROOT="^DGPR(408.12,"_IEN12_",""E"")"
  1. .S SUBIEN=""
  1. .Q:'$D(@ACTROOT@("B",EFFDT))
  1. .F S SUBIEN=$O(@ACTROOT@("B",EFFDT,SUBIEN)) Q:'SUBIEN D
  1. ..I $P($G(@ACTROOT@(SUBIEN,0)),"^",2)=ACTIVE Q
  1. ..S FDA(408.1275,SUBIEN_","_IEN12_",",.02)=ACTIVE
  1. ..D FILE^DIE("K","FDA","DIERR")
  1. ; update arrays
  1. K ^TMP($J,"EASXDR"),ERROR
  1. M ^TMP($J,"EASXDR","MRGTO",MRGTOIEN)=^DGPR(408.12,MRGTOIEN)
  1. M ^TMP($J,"EASXDR","MRGFR",MRGFRIEN)=^DGPR(408.12,MRGFRIEN)
  1. ;D LOOP^EASXDR1
  1. Q
  1. FINDSSN(IEN40812,SSN) ;find SSN associated with Patient Relation entry
  1. N ROOT,NODE12,POINT
  1. S SSN="UNKNOWN"
  1. S NODE12=$G(^DGPR(408.12,IEN40812,0))
  1. S POINT=$P(NODE12,"^",3)
  1. S ROOT="^"_$P(POINT,";",2)_$P(POINT,";")_")"
  1. I '$D(@ROOT@(0)) Q
  1. S SSN=$P($G(@ROOT@(0)),"^",9)
  1. Q
  1. DELETE ; entry point from 'Delete Duplicate MT/Copay Dependents' menu option
  1. N MSG,DTOUT,DUOUT,DIRUT,DIROUT,DA,DIR,DIC,X,Y,DFN,DGMSGF,SSN,VETNAM
  1. S DGMSGF=1
  1. S DIR(0)="408.12,.03"
  1. S DIR("A")="Select MT/Copay Dependent to be deleted"
  1. S DIR("?")="Select the SSN of the patient whose Patient Relation entries should be deleted."
  1. D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
  1. S IEN12=$O(^DGPR(408.12,"C",Y,""))
  1. I 'IEN12 W !!?2,Y(0)," Cannot be deleted. Please select a new entry.",! G DELETE
  1. S DIC="^DGPR(408.12,",DA=IEN12,DIQ(0)="R" D EN^DIQ
  1. K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
  1. S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Would you like to PERMANENTLY DELETE this record"
  1. S DIR("?",1)="Answer 'YES' if you would like to continue the deletion process"
  1. S DIR("?",2)="using the displayed patient. This process will permanently delete the"
  1. S DIR("?")="408.13, 408.21, and 408.22 file entries associated with the selected patient."
  1. D ^DIR
  1. G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!('Y) DELETE
  1. S MSG=$$REMOVE^EASXDR1(IEN12,"")
  1. I 'MSG W !?2,"No Patient Relation entries were deleted for this patient.",!! G DELETE
  1. W !?2,+MSG_" Patient Relation "_$S(+MSG=1:"entry was",1:"entries were")_" successfully deleted."
  1. W !!?2,"Data deleted during this process will be stored for 10 days"
  1. W !?2,"in the following global: ^XTMP(""EASXDR1"",""DATA"",""DELETE"",408.12,"_IEN12_")",!!
  1. G DELETE
  1. Q