VAQLED03 ;ALB/JFP,JRP - PDX, DISPLAY POSSIBLE MATCHES, SCREEN;01MAR93
;;1.5;PATIENT DATA EXCHANGE;**6,10**;NOV 17, 1993
EP ; -- Main entry point for the list processor
K DFNARR
W !!,"Checking for potential duplicates and matches of remote patient "
S VAQDFN=$$GETDFN^VAQUTL97(VAQPTNM,1) I +VAQDFN>0 S DFNARR(VAQDFN)=""
S VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1) I +VAQDFN>0 S DFNARR(VAQDFN)=""
;
N DOB,SSN,DPTNM,DPTKS,DPTKD
S DPTNM=VAQPTNM,SSN=VAQISSN
S DOB=$S(VAQIDOB'="":VAQIDOB,1:" ")
S (DPTKS,DPTKD)=0
D ^DPTDUP ; -- Duplicate checker
I $D(DPTD)&(DPTD>0) S VAQDFN="" F S VAQDFN=$O(DPTD(VAQDFN)) Q:VAQDFN="" S DFNARR(VAQDFN)=""
I '$D(VAQCHK) D EN^VALM("VAQ MATCHES PDX8") K DPTD
Q
;
INIT ; -- Builds array of possible matches
K ^TMP("VAQL3",$J),^TMP("VAQIDX",$J)
S DFN="",(VAQECNT,VALMCNT)=0
F S DFN=$O(DPTD(DFN)) Q:DFN="" D SETD
I VAQECNT=0 D
.S X=$$SETSTR^VALM1(" ","",1,79) D TMP
.S X=$$SETSTR^VALM1(" ** No possible matches found for patient entered... ","",1,80) D TMP
Q
;
SETD ; -- Set data for display in list processor
S VAQECNT=VAQECNT+1
D DEM^VADPT
S X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
S X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
S X=$$SETFLD^VALM1($P(VADM(2),U,2),X,"SSN")
S VAERR=$$DOBFMT^VAQUTL99($P(VADM(3),U,1))
S X=$$SETFLD^VALM1(VAERR,X,"DOB")
S X=$$SETFLD^VALM1(VA("PID"),X,"PID")
D TMP
K VA,VADM,VAERR ; -- cleans up local variables set by vadpt call
Q
;
TMP ; -- Set the array used by list processor
S VALMCNT=VALMCNT+1
S ^TMP("VAQL3",$J,VALMCNT,0)=$E(X,1,79)
S ^TMP("VAQL3",$J,"IDX",VALMCNT,VAQECNT)=""
S ^TMP("VAQIDX",$J,VAQECNT)=DFNTR_"^"_DFN
Q
;
HD ; -- Make header line for list processor
S VALMHDR(1)=$$INSERT^VAQUTL1("Remote Patient Name","",9)
S VALMHDR(1)=$$INSERT^VAQUTL1("DOB",VALMHDR(1),41)
S VALMHDR(1)=$$INSERT^VAQUTL1("SSN",VALMHDR(1),54)
S VALMHDR(2)=$$INSERT^VAQUTL1(VAQPTNM,"",9)
S VALMHDR(2)=$$INSERT^VAQUTL1(VAQEDOB,VALMHDR(2),41)
S VALMHDR(2)=$$INSERT^VAQUTL1(VAQESSN,VALMHDR(2),54)
S VALMHDR(3)=" "
Q
;
SEL ; -- Select possible match
D EN^VALM2($G(XQORNOD(0)),"S")
Q:'$D(VALMY)
S SDI=""
S SDI=$O(VALMY(SDI))
S SDAT=$G(^TMP("VAQIDX",$J,SDI))
S DFNTR=$P(SDAT,U,1)
S DFNPT=$P(SDAT,U,2)
D MRGECHK
S VAQBCK=1
K VALMBCK
Q
;
EXP ; -- Displays MAS minimal information from patient file (2)
D EN^VALM2($G(XQORNOD(0)),"S")
Q:'$D(VALMY)
S SDI=""
F S SDI=$O(VALMY(SDI)) Q:SDI="" D
.S SDAT=$G(^TMP("VAQIDX",$J,SDI))
.S DFN=$P(SDAT,U,2)
.D PT^VAQDIS01 ; -- display local patient data
S VALMBCK="R"
Q
;
NEW ; -- Creates new patient in local database
D ^VAQLED07
K VALMBCK
Q
;
EXIT ; -- Note: The list processor cleans up its own variables.
; All other variables cleaned up here.
;
K ^TMP("VAQL3",$J),^TMP("VAQIDX",$J),DFNARR
K VAQECNT,DFN,DPTD,X,VALMY,SDI,SDAT
Q
;
MRGECHK ;CHECK FOR EXACT MATCH BEFORE ALLOWING MERGE
N TMP,LOCNAME,LOCSSN,LOCDOB,DIFF
;GET LOCAL PATIENT
S TMP=$$PATINFO^VAQUTL1(DFNPT)
S LOCNAME=$P(TMP,"^",1)
S LOCSSN=$TR($P(TMP,"^",2),"-","")
S LOCDOB=$$DATE^VAQUTL99($P(TMP,"^",3))
S:(LOCDOB="-1") LOCDOB=""
;COMPARE AGAINST REMOTE PATIENT
S DIFF=0
S:(VAQPTNM'=LOCNAME) DIFF=DIFF+1
S:(VAQISSN'=LOCSSN) DIFF=DIFF+2
S:(VAQIDOB'=LOCDOB) DIFF=DIFF+4
;NO DIFFERENCES - MERGE ALLOWED
I ('DIFF) D EP^VAQLED02 Q
;PRINT DIFFERENCES
D CLEAR^VALM1
S TMP="***** MERGING OF REMOTE PATIENT WITH LOCAL PATIENT NOT ALLOWED *****"
S X=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
W $C(7),X
S TMP=""
I (DIFF>3) S TMP="DATE OF BIRTH",DIFF=DIFF-4
I (DIFF>1) S:(TMP'="") TMP=" and "_TMP S TMP="SOCIAL SECURITY NUMBER"_TMP,DIFF=DIFF-2
I (DIFF) S:(TMP'="") TMP=" and "_TMP S TMP="NAME"_TMP
S TMP="***** "_TMP_" do"_$S((TMP'[" and "):"es",1:"")_" not match *****"
S X=$$INSERT^VAQUTL1(TMP,"",(40-($L(TMP)/2)))
W !,X,$C(7)
W !!,?22,"Name",?48,"SSN",?64,"DOB"
S X=$$REPEAT^VAQUTL1("-",30)
W !,?8,X,?43,$E(X,1,12),?60,$E(X,1,10)
W !," Local: ",LOCNAME,?43,$$DASHSSN^VAQUTL99(LOCSSN),?60,$$DOBFMT^VAQUTL99(LOCDOB,0)
W !,"Remote: ",VAQPTNM,?43,VAQESSN,?60,VAQEDOB
W !!!
W !,?3,"Pertinent patient data must match in order for the upload process"
W !,?3,"to continue. Local and remote patient should be verified using the"
W !,?3,"appropriate procedures. Once verified, the Load/Edit Patient Data"
W !,?3,"option, which is found in the Registration Menu, should be used to"
W !,?3,"correct the information."
F X=$Y:1:(IOSL-5) W !
D PAUSE^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQLED03 4539 printed Dec 13, 2024@02:26 Page 2
VAQLED03 ;ALB/JFP,JRP - PDX, DISPLAY POSSIBLE MATCHES, SCREEN;01MAR93
+1 ;;1.5;PATIENT DATA EXCHANGE;**6,10**;NOV 17, 1993
EP ; -- Main entry point for the list processor
+1 KILL DFNARR
+2 WRITE !!,"Checking for potential duplicates and matches of remote patient "
+3 SET VAQDFN=$$GETDFN^VAQUTL97(VAQPTNM,1)
IF +VAQDFN>0
SET DFNARR(VAQDFN)=""
+4 SET VAQDFN=$$GETDFN^VAQUTL97(VAQISSN,1)
IF +VAQDFN>0
SET DFNARR(VAQDFN)=""
+5 ;
+6 NEW DOB,SSN,DPTNM,DPTKS,DPTKD
+7 SET DPTNM=VAQPTNM
SET SSN=VAQISSN
+8 SET DOB=$SELECT(VAQIDOB'="":VAQIDOB,1:" ")
+9 SET (DPTKS,DPTKD)=0
+10 ; -- Duplicate checker
DO ^DPTDUP
+11 IF $DATA(DPTD)&(DPTD>0)
SET VAQDFN=""
FOR
SET VAQDFN=$ORDER(DPTD(VAQDFN))
if VAQDFN=""
QUIT
SET DFNARR(VAQDFN)=""
+12 IF '$DATA(VAQCHK)
DO EN^VALM("VAQ MATCHES PDX8")
KILL DPTD
+13 QUIT
+14 ;
INIT ; -- Builds array of possible matches
+1 KILL ^TMP("VAQL3",$JOB),^TMP("VAQIDX",$JOB)
+2 SET DFN=""
SET (VAQECNT,VALMCNT)=0
+3 FOR
SET DFN=$ORDER(DPTD(DFN))
if DFN=""
QUIT
DO SETD
+4 IF VAQECNT=0
Begin DoDot:1
+5 SET X=$$SETSTR^VALM1(" ","",1,79)
DO TMP
+6 SET X=$$SETSTR^VALM1(" ** No possible matches found for patient entered... ","",1,80)
DO TMP
End DoDot:1
+7 QUIT
+8 ;
SETD ; -- Set data for display in list processor
+1 SET VAQECNT=VAQECNT+1
+2 DO DEM^VADPT
+3 SET X=$$SETFLD^VALM1(VAQECNT,"","ENTRY")
+4 SET X=$$SETFLD^VALM1(VADM(1),X,"LOCAL PATIENT NAME")
+5 SET X=$$SETFLD^VALM1($PIECE(VADM(2),U,2),X,"SSN")
+6 SET VAERR=$$DOBFMT^VAQUTL99($PIECE(VADM(3),U,1))
+7 SET X=$$SETFLD^VALM1(VAERR,X,"DOB")
+8 SET X=$$SETFLD^VALM1(VA("PID"),X,"PID")
+9 DO TMP
+10 ; -- cleans up local variables set by vadpt call
KILL VA,VADM,VAERR
+11 QUIT
+12 ;
TMP ; -- Set the array used by list processor
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("VAQL3",$JOB,VALMCNT,0)=$EXTRACT(X,1,79)
+3 SET ^TMP("VAQL3",$JOB,"IDX",VALMCNT,VAQECNT)=""
+4 SET ^TMP("VAQIDX",$JOB,VAQECNT)=DFNTR_"^"_DFN
+5 QUIT
+6 ;
HD ; -- Make header line for list processor
+1 SET VALMHDR(1)=$$INSERT^VAQUTL1("Remote Patient Name","",9)
+2 SET VALMHDR(1)=$$INSERT^VAQUTL1("DOB",VALMHDR(1),41)
+3 SET VALMHDR(1)=$$INSERT^VAQUTL1("SSN",VALMHDR(1),54)
+4 SET VALMHDR(2)=$$INSERT^VAQUTL1(VAQPTNM,"",9)
+5 SET VALMHDR(2)=$$INSERT^VAQUTL1(VAQEDOB,VALMHDR(2),41)
+6 SET VALMHDR(2)=$$INSERT^VAQUTL1(VAQESSN,VALMHDR(2),54)
+7 SET VALMHDR(3)=" "
+8 QUIT
+9 ;
SEL ; -- Select possible match
+1 DO EN^VALM2($GET(XQORNOD(0)),"S")
+2 if '$DATA(VALMY)
QUIT
+3 SET SDI=""
+4 SET SDI=$ORDER(VALMY(SDI))
+5 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
+6 SET DFNTR=$PIECE(SDAT,U,1)
+7 SET DFNPT=$PIECE(SDAT,U,2)
+8 DO MRGECHK
+9 SET VAQBCK=1
+10 KILL VALMBCK
+11 QUIT
+12 ;
EXP ; -- Displays MAS minimal information from patient file (2)
+1 DO EN^VALM2($GET(XQORNOD(0)),"S")
+2 if '$DATA(VALMY)
QUIT
+3 SET SDI=""
+4 FOR
SET SDI=$ORDER(VALMY(SDI))
if SDI=""
QUIT
Begin DoDot:1
+5 SET SDAT=$GET(^TMP("VAQIDX",$JOB,SDI))
+6 SET DFN=$PIECE(SDAT,U,2)
+7 ; -- display local patient data
DO PT^VAQDIS01
End DoDot:1
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
NEW ; -- Creates new patient in local database
+1 DO ^VAQLED07
+2 KILL VALMBCK
+3 QUIT
+4 ;
EXIT ; -- Note: The list processor cleans up its own variables.
+1 ; All other variables cleaned up here.
+2 ;
+3 KILL ^TMP("VAQL3",$JOB),^TMP("VAQIDX",$JOB),DFNARR
+4 KILL VAQECNT,DFN,DPTD,X,VALMY,SDI,SDAT
+5 QUIT
+6 ;
MRGECHK ;CHECK FOR EXACT MATCH BEFORE ALLOWING MERGE
+1 NEW TMP,LOCNAME,LOCSSN,LOCDOB,DIFF
+2 ;GET LOCAL PATIENT
+3 SET TMP=$$PATINFO^VAQUTL1(DFNPT)
+4 SET LOCNAME=$PIECE(TMP,"^",1)
+5 SET LOCSSN=$TRANSLATE($PIECE(TMP,"^",2),"-","")
+6 SET LOCDOB=$$DATE^VAQUTL99($PIECE(TMP,"^",3))
+7 if (LOCDOB="-1")
SET LOCDOB=""
+8 ;COMPARE AGAINST REMOTE PATIENT
+9 SET DIFF=0
+10 if (VAQPTNM'=LOCNAME)
SET DIFF=DIFF+1
+11 if (VAQISSN'=LOCSSN)
SET DIFF=DIFF+2
+12 if (VAQIDOB'=LOCDOB)
SET DIFF=DIFF+4
+13 ;NO DIFFERENCES - MERGE ALLOWED
+14 IF ('DIFF)
DO EP^VAQLED02
QUIT
+15 ;PRINT DIFFERENCES
+16 DO CLEAR^VALM1
+17 SET TMP="***** MERGING OF REMOTE PATIENT WITH LOCAL PATIENT NOT ALLOWED *****"
+18 SET X=$$INSERT^VAQUTL1(TMP,"",(40-($LENGTH(TMP)/2)))
+19 WRITE $CHAR(7),X
+20 SET TMP=""
+21 IF (DIFF>3)
SET TMP="DATE OF BIRTH"
SET DIFF=DIFF-4
+22 IF (DIFF>1)
if (TMP'="")
SET TMP=" and "_TMP
SET TMP="SOCIAL SECURITY NUMBER"_TMP
SET DIFF=DIFF-2
+23 IF (DIFF)
if (TMP'="")
SET TMP=" and "_TMP
SET TMP="NAME"_TMP
+24 SET TMP="***** "_TMP_" do"_$SELECT((TMP'[" and "):"es",1:"")_" not match *****"
+25 SET X=$$INSERT^VAQUTL1(TMP,"",(40-($LENGTH(TMP)/2)))
+26 WRITE !,X,$CHAR(7)
+27 WRITE !!,?22,"Name",?48,"SSN",?64,"DOB"
+28 SET X=$$REPEAT^VAQUTL1("-",30)
+29 WRITE !,?8,X,?43,$EXTRACT(X,1,12),?60,$EXTRACT(X,1,10)
+30 WRITE !," Local: ",LOCNAME,?43,$$DASHSSN^VAQUTL99(LOCSSN),?60,$$DOBFMT^VAQUTL99(LOCDOB,0)
+31 WRITE !,"Remote: ",VAQPTNM,?43,VAQESSN,?60,VAQEDOB
+32 WRITE !!!
+33 WRITE !,?3,"Pertinent patient data must match in order for the upload process"
+34 WRITE !,?3,"to continue. Local and remote patient should be verified using the"
+35 WRITE !,?3,"appropriate procedures. Once verified, the Load/Edit Patient Data"
+36 WRITE !,?3,"option, which is found in the Registration Menu, should be used to"
+37 WRITE !,?3,"correct the information."
+38 FOR X=$Y:1:(IOSL-5)
WRITE !
+39 DO PAUSE^VALM1
+40 QUIT
