source: FOIAVistA/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EASXDR.m@ 1764

Last change on this file since 1764 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1EASXDR ;ALB/BRM - ROUTINE TO MERGE ENTRIES DURING PATIENT MERGE; ; 5/10/02 9:27am
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**10**;Mar 15, 2001
3 ;
4EN(ARRAY) ;Entry point called with the name of the array containing the
5 ; from and to pointers of the record being merged. The array is
6 ; formatted as follows:
7 ; ARRAY(FROM_IEN,TO_IEN,"FROM_IEN;DPT(","TO_IEN;DPT(")=""
8 ;
9 ; The code in this routine will prevent duplicate dependent entries
10 ; from being created when the from and to records are the same
11 ;
12 N EASARY,IEN,DFNFR,DFNTO,IENFR,IENTO,OKTOMRG
13 F DFNFR=0:0 S DFNFR=$O(@ARRAY@(DFNFR)) Q:$G(DFNFR)'>0 D
14 .S DFNTO=$O(@ARRAY@(DFNFR,0))
15 .S IENFR=$O(@ARRAY@(DFNFR,DFNTO,0))
16 .S IENTO=$O(@ARRAY@(DFNFR,DFNTO,IENFR,0))
17 .;attempt to merge relation entries
18 .S OKTOMRG=$$CHKRELAT^EASXDR1(DFNFR,DFNTO,1)
19 Q
20OPTION ; entry point from 'Fix Duplicate Patient Relations' menu option
21 N DTOUT,DUOUT,DIRUT,DIROUT,DA,DIR,DIC,X,Y,DFN,DGMSGF,SSN,VETNAM
22 S DGMSGF=1
23 S DIR(0)="408.12,.03"
24 S DIR("A")="Select Patient SSN"
25 S DIR("?")="Select the SSN of the patient whose Patient Relation entries should be merged."
26 D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
27 W !
28 I '+Y W !?2,Y(0)," Cannot be merged. Please select a new entry."
29 I $P(Y,";",2)["DGPR(408.13," D G:'$D(DFN) OPTION
30 .I '$D(^DGPR(408.12,"C",Y)) W !?2,Y(0)," Cannot be merged. Please select a new entry." Q
31 .S IEN12=$O(^DGPR(408.12,"C",Y,""))
32 .S DFN=$P($G(^DGPR(408.12,IEN12,0)),"^")
33 .S VETNAM=$P($G(^DPT(DFN,0)),"^")
34 .S SSN=$P($G(^DPT(DFN,0)),"^",9)
35 .W !?2,Y(0)," is not in the Patient (#2) file."
36 .W !!?2,"The following patient must be used to merge this entry:"
37 .W !?2,"SSN:",SSN,?20,"Patient Name:",VETNAM,!!
38 .K DIR,Y
39 .S DIR(0)="Y",DIR("B")="YES"
40 .S DIR("A")="Would you like to continue this merge using "_VETNAM
41 .S DIR("?",1)="Answer 'YES' if you would like to continue the merge process"
42 .S DIR("?",2)="using the displayed patient. This will merge all duplicate"
43 .S DIR("?")="Patient Relations associated with the selected patient."
44 .D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
45 .I 'Y K DFN Q
46 .S Y=DFN
47 S DFN=+Y
48 S MSG=$$CHKRELAT^EASXDR1(DFN,DFN,0)
49 I 'MSG W !?2,"No Patient Relation entries were merged for this patient.",!! G OPTION
50 W !?2,+MSG_" Patient Relation "_$S(+MSG=1:"entry was",1:"entries were")_" successfully merged."
51 W !!?2,"Data deleted during this merge will be stored for 10 days"
52 W !?2,"in the following global: ^XTMP(""EASXDR1"",""DATA"","_DFN_")",!!
53 G OPTION
54 Q
55CHGACT(MRGFRIEN,MRGTOIEN,EFFDT) ;
56 N DIE,DIR,DIRUT,DTOUT,DUOUT,DIROUT,DIC,DA,DR,DIQ,X,Y,SSNFR,SSNTO
57 N ACTIVE
58 ; display data about each record
59 D FINDSSN(MRGFRIEN,.SSNFR),FINDSSN(MRGTOIEN,.SSNTO)
60 W:SSNFR'="" !!,"SSN:"_SSNFR
61 S DIC="^DGPR(408.12,",DA=MRGFRIEN,DIQ(0)="R" D EN^DIQ
62 W:SSNTO'="" !,"SSN:"_SSNTO
63 S DIC="^DGPR(408.12,",DA=MRGTOIEN,DIQ(0)="R" D EN^DIQ
64 ; ask user to enter the correct active flag for this date
65 S DIR(0)="Y"
66 S DIR("A")="Should the active flag be 'YES' or 'NO' for "_$$FMTE^XLFDT($G(EFFDT))
67 D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q
68 S ACTIVE=Y
69 N IEN12,SUBIEN,ACTROOT,FDA,DIERR
70 F IEN12=MRGFRIEN,MRGTOIEN D
71 .S ACTROOT="^DGPR(408.12,"_IEN12_",""E"")"
72 .S SUBIEN=""
73 .Q:'$D(@ACTROOT@("B",EFFDT))
74 .F S SUBIEN=$O(@ACTROOT@("B",EFFDT,SUBIEN)) Q:'SUBIEN D
75 ..I $P($G(@ACTROOT@(SUBIEN,0)),"^",2)=ACTIVE Q
76 ..S FDA(408.1275,SUBIEN_","_IEN12_",",.02)=ACTIVE
77 ..D FILE^DIE("K","FDA","DIERR")
78 ; update arrays
79 K ^TMP($J,"EASXDR"),ERROR
80 M ^TMP($J,"EASXDR","MRGTO",MRGTOIEN)=^DGPR(408.12,MRGTOIEN)
81 M ^TMP($J,"EASXDR","MRGFR",MRGFRIEN)=^DGPR(408.12,MRGFRIEN)
82 ;D LOOP^EASXDR1
83 Q
84FINDSSN(IEN40812,SSN) ;find SSN associated with Patient Relation entry
85 N ROOT,NODE12,POINT
86 S SSN="UNKNOWN"
87 S NODE12=$G(^DGPR(408.12,IEN40812,0))
88 S POINT=$P(NODE12,"^",3)
89 S ROOT="^"_$P(POINT,";",2)_$P(POINT,";")_")"
90 I '$D(@ROOT@(0)) Q
91 S SSN=$P($G(@ROOT@(0)),"^",9)
92 Q
93DELETE ; entry point from 'Delete Duplicate MT/Copay Dependents' menu option
94 N MSG,DTOUT,DUOUT,DIRUT,DIROUT,DA,DIR,DIC,X,Y,DFN,DGMSGF,SSN,VETNAM
95 S DGMSGF=1
96 S DIR(0)="408.12,.03"
97 S DIR("A")="Select MT/Copay Dependent to be deleted"
98 S DIR("?")="Select the SSN of the patient whose Patient Relation entries should be deleted."
99 D ^DIR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))
100 S IEN12=$O(^DGPR(408.12,"C",Y,""))
101 I 'IEN12 W !!?2,Y(0)," Cannot be deleted. Please select a new entry.",! G DELETE
102 S DIC="^DGPR(408.12,",DA=IEN12,DIQ(0)="R" D EN^DIQ
103 K DIR,Y,DTOUT,DIROUT,DIRUT,DUOUT
104 S DIR(0)="Y",DIR("B")="NO"
105 S DIR("A")="Would you like to PERMANENTLY DELETE this record"
106 S DIR("?",1)="Answer 'YES' if you would like to continue the deletion process"
107 S DIR("?",2)="using the displayed patient. This process will permanently delete the"
108 S DIR("?")="408.13, 408.21, and 408.22 file entries associated with the selected patient."
109 D ^DIR
110 G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT))!('Y) DELETE
111 S MSG=$$REMOVE^EASXDR1(IEN12,"")
112 I 'MSG W !?2,"No Patient Relation entries were deleted for this patient.",!! G DELETE
113 W !?2,+MSG_" Patient Relation "_$S(+MSG=1:"entry was",1:"entries were")_" successfully deleted."
114 W !!?2,"Data deleted during this process will be stored for 10 days"
115 W !?2,"in the following global: ^XTMP(""EASXDR1"",""DATA"",""DELETE"",408.12,"_IEN12_")",!!
116 G DELETE
117 Q
Note: See TracBrowser for help on using the repository browser.