source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQLED03.m@ 1354

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1VAQLED03 ;ALB/JFP,JRP - PDX, DISPLAY POSSIBLE MATCHES, SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**6,10**;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 K DFNARR
5 W !!,"Checking for potential duplicates and matches of remote patient "
6 S VAQDFN=$$GETDFN^VAQUTL97(VAQPTNM,1) I +VAQDFN>0 S DFNARR(VAQDFN)=""
7 S VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1) I +VAQDFN>0 S DFNARR(VAQDFN)=""
8 ;
9 N DOB,SSN,DPTNM,DPTKS,DPTKD
10 S DPTNM=VAQPTNM,SSN=VAQISSN
11 S DOB=$S(VAQIDOB'="":VAQIDOB,1:" ")
12 S (DPTKS,DPTKD)=0
13 D ^DPTDUP ; -- Duplicate checker
14 I $D(DPTD)&(DPTD>0) S VAQDFN="" F S VAQDFN=$O(DPTD(VAQDFN)) Q:VAQDFN="" S DFNARR(VAQDFN)=""
15 I '$D(VAQCHK) D EN^VALM("VAQ MATCHES PDX8") K DPTD
16 Q
17 ;
18INIT ; -- Builds array of possible matches
19 K ^TMP("VAQL3",$J),^TMP("VAQIDX",$J)
20 S DFN="",(VAQECNT,VALMCNT)=0
21 F S DFN=$O(DPTD(DFN)) Q:DFN="" D SETD
22 I VAQECNT=0 D
23 .S X=$$SETSTR^VALM1(" ","",1,79) D TMP
24 .S X=$$SETSTR^VALM1(" ** No possible matches found for patient entered... ","",1,80) D TMP
25 Q
26 ;
27SETD ; -- Set data for display in list processor
28 S VAQECNT=VAQECNT+1
29 D DEM^VADPT
30 S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
31 S X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
32 S X=$$SETFLD^VALM1($P(VADM(2),U,2),X,"SSN")
33 S VAERR=$$DOBFMT^VAQUTL99($P(VADM(3),U,1))
34 S X=$$SETFLD^VALM1(VAERR,X,"DOB")
35 S X=$$SETFLD^VALM1(VA("PID"),X,"PID")
36 D TMP
37 K VA,VADM,VAERR ; -- cleans up local variables set by vadpt call
38 Q
39 ;
40TMP ; -- Set the array used by list processor
41 S VALMCNT=VALMCNT+1
42 S ^TMP("VAQL3",$J,VALMCNT,0)=$E(X,1,79)
43 S ^TMP("VAQL3",$J,"IDX",VALMCNT,VAQECNT)=""
44 S ^TMP("VAQIDX",$J,VAQECNT)=DFNTR_"^"_DFN
45 Q
46 ;
47HD ; -- Make header line for list processor
48 S VALMHDR(1)=$$INSERT^VAQUTL1("Remote Patient Name","",9)
49 S VALMHDR(1)=$$INSERT^VAQUTL1("DOB",VALMHDR(1),41)
50 S VALMHDR(1)=$$INSERT^VAQUTL1("SSN",VALMHDR(1),54)
51 S VALMHDR(2)=$$INSERT^VAQUTL1(VAQPTNM,"",9)
52 S VALMHDR(2)=$$INSERT^VAQUTL1(VAQEDOB,VALMHDR(2),41)
53 S VALMHDR(2)=$$INSERT^VAQUTL1(VAQESSN,VALMHDR(2),54)
54 S VALMHDR(3)=" "
55 Q
56 ;
57SEL ; -- Select possible match
58 D EN^VALM2($G(XQORNOD(0)),"S")
59 Q:'$D(VALMY)
60 S SDI=""
61 S SDI=$O(VALMY(SDI))
62 S SDAT=$G(^TMP("VAQIDX",$J,SDI))
63 S DFNTR=$P(SDAT,U,1)
64 S DFNPT=$P(SDAT,U,2)
65 D MRGECHK
66 S VAQBCK=1
67 K VALMBCK
68 Q
69 ;
70EXP ; -- Displays MAS minimal information from patient file (2)
71 D EN^VALM2($G(XQORNOD(0)),"S")
72 Q:'$D(VALMY)
73 S SDI=""
74 F S SDI=$O(VALMY(SDI)) Q:SDI="" D
75 .S SDAT=$G(^TMP("VAQIDX",$J,SDI))
76 .S DFN=$P(SDAT,U,2)
77 .D PT^VAQDIS01 ; -- display local patient data
78 S VALMBCK="R"
79 Q
80 ;
81NEW ; -- Creates new patient in local database
82 D ^VAQLED07
83 K VALMBCK
84 Q
85 ;
86EXIT ; -- Note: The list processor cleans up its own variables.
87 ; All other variables cleaned up here.
88 ;
89 K ^TMP("VAQL3",$J),^TMP("VAQIDX",$J),DFNARR
90 K VAQECNT,DFN,DPTD,X,VALMY,SDI,SDAT
91 Q
92 ;
93MRGECHK ;CHECK FOR EXACT MATCH BEFORE ALLOWING MERGE
94 N TMP,LOCNAME,LOCSSN,LOCDOB,DIFF
95 ;GET LOCAL PATIENT
96 S TMP=$$PATINFO^VAQUTL1(DFNPT)
97 S LOCNAME=$P(TMP,"^",1)
98 S LOCSSN=$TR($P(TMP,"^",2),"-","")
99 S LOCDOB=$$DATE^VAQUTL99($P(TMP,"^",3))
100 S:(LOCDOB="-1") LOCDOB=""
101 ;COMPARE AGAINST REMOTE PATIENT
102 S DIFF=0
103 S:(VAQPTNM'=LOCNAME) DIFF=DIFF+1
104 S:(VAQISSN'=LOCSSN) DIFF=DIFF+2
105 S:(VAQIDOB'=LOCDOB) DIFF=DIFF+4
106 ;NO DIFFERENCES - MERGE ALLOWED
107 I ('DIFF) D EP^VAQLED02 Q
108 ;PRINT DIFFERENCES
109 D CLEAR^VALM1
110 S TMP="***** MERGING OF REMOTE PATIENT WITH LOCAL PATIENT NOT ALLOWED *****"
111 S X=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
112 W $C(7),X
113 S TMP=""
114 I (DIFF>3) S TMP="DATE OF BIRTH",DIFF=DIFF-4
115 I (DIFF>1) S:(TMP'="") TMP=" and "_TMP S TMP="SOCIAL SECURITY NUMBER"_TMP,DIFF=DIFF-2
116 I (DIFF) S:(TMP'="") TMP=" and "_TMP S TMP="NAME"_TMP
117 S TMP="***** "_TMP_" do"_$S((TMP'[" and "):"es",1:"")_" not match *****"
118 S X=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
119 W !,X,$C(7)
120 W !!,?22,"Name",?48,"SSN",?64,"DOB"
121 S X=$$REPEAT^VAQUTL1("-",30)
122 W !,?8,X,?43,$E(X,1,12),?60,$E(X,1,10)
123 W !," Local: ",LOCNAME,?43,$$DASHSSN^VAQUTL99(LOCSSN),?60,$$DOBFMT^VAQUTL99(LOCDOB,0)
124 W !,"Remote: ",VAQPTNM,?43,VAQESSN,?60,VAQEDOB
125 W !!!
126 W !,?3,"Pertinent patient data must match in order for the upload process"
127 W !,?3,"to continue. Local and remote patient should be verified using the"
128 W !,?3,"appropriate procedures. Once verified, the Load/Edit Patient Data"
129 W !,?3,"option, which is found in the Registration Menu, should be used to"
130 W !,?3,"correct the information."
131 F X=$Y:1:(IOSL-5) W !
132 D PAUSE^VALM1
133 Q
Note: See TracBrowser for help on using the repository browser.