- MPIFBT3 ;SLC/ARS-BATCH RESPONSE FROM MPI ;FEB 4, 1997
- ;;1.0;MASTER PATIENT INDEX VISTA;**1,3,10,17,21,24,28,31,33,35,43,52,58,60,68**;30 Apr 99;Build 2
- ;
- ; Integration Agreements Utilized:
- ; ^DPT("AICN", ^DPT("AICNL", ^DPT("AMPIMIS" - #2070
- ; EXC^RGHLLOG - #2796
- ; FILE^VAFCTFU - #2988
- ; NAME^VAFCPID2 - #3492
- ; EN1^DGPFMPI - #6002
- ;
- MULT(CNTR,ACK5,SEP,MPIMSG,PATID) ;multiple RDT segments
- N NEXTTF,MPITMP S CNTR=$O(^XTMP($J,"MPIF","MPIIN",CNTR)),NEXTTF=$P(ACK5,SEP,8)
- S MPITMP=$O(^XTMP($J,"MPIF","MPIIN",CNTR)) Q:MPITMP'>0
- S ACK5=^XTMP($J,"MPIF","MPIIN",MPITMP) K NEXTTF,MPITMP
- I $P(ACK5,SEP)="RDT" D MULT(.CNTR,ACK5,SEP,MPIMSG,PATID) ; ^ add to treating facility list. If not RDT continue on processing next msh
- Q
- VFYRDT(ACK4,SEP,CNTR,PATID,SITE,MPIMSG) ;Here is the meat
- N MPIY,IEN,MPICMOR,MPICOMP S DGSENFLG=""
- S MPICOMP=$E(HL("ECH"),1)
- D RDT^MPIFSA3(.CNTR,.HL,.ACK4)
- D FINDHM(PATID,SEP,.MPIY,MPIMSG,CNTR)
- Q:$D(^XTMP($J,"MPIF","MSHERR"))
- N MPINUM,MPICKG,MPIIT,DR,DIE,X,MPIIPPF,MPIPPF,RESLT,MPIFICN
- S MPIFICN=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",6),MPICKG=$P(MPIFICN,"V",2),MPINUM=$P(MPIFICN,"V",1)
- ;check if ICN already in use in Patient file
- I $D(^DPT("AICN",MPINUM)) D
- .Q:PATID=$O(^DPT("AICN",MPINUM,"")) ; same patient
- .S ^XTMP($J,"MPIF","MSHERR")="ICN already in use"
- .N DFN2 S DFN2=$O(^DPT("AICN",MPINUM,""))
- .D TWODFNS^MPIF002(DFN2,PATID,MPINUM)
- .;**52 need to trigger A28 add as if not found
- .S MPIFRPC=1 D A28^MPIFQ3(PATID) K MPIFRPC
- Q:$D(^XTMP($J,"MPIF","MSHERR"))
- ;**60 (elz) MVI_793 need to store full ICN in new field
- S DIE="^DPT(",DA=$P(MPIY,"^",1),MPIIT=$P(MPIY,"^",1),DR="991.01////^S X=MPINUM;991.02////^S X=MPICKG;991.1////^S X=MPIFICN" D ^DIE K DR,DIE,DA
- S IEN=$P(MPIY,"^") ; check if need to kill Local/MISSING ICN field
- I $D(^DPT("AMPIMIS",IEN)) K ^DPT("AMPIMIS",IEN)
- I $D(^DPT("AICNL",1,IEN)) D
- .S DIE="^DPT(",DA=IEN,DR="991.04///@" D ^DIE K DR,DIE,DA
- S MPIIPPF=""
- S MPIPPF=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",5),MPICMOR=$$LKUP^XUAF4(MPIPPF)
- I MPICMOR'="" S MPIIPPF=$$CHANGE^MPIF001(MPIIT,MPICMOR)
- I +MPIIPPF<0 D EXC^RGHLLOG(211,"Around line number "_(CNTR*2)_" CMOR= "_MPIPPF_" DFN= "_MPIIT_" MESSAGE# "_MPIMSG,MPIIT)
- Q:+MPIIPPF<0
- I $D(^TMP("MPIFVQQ",$J,CNTR,"TF")) D
- . N MPINTFI,MPINTF,TFSTRG,TFIEN
- . S MPINTFI=0,MPINTF="",TFIEN="",TFSTRG=""
- . F S MPINTFI=$O(^TMP("MPIFVQQ",$J,CNTR,"TF",MPINTFI)) Q:'MPINTFI D
- .. S MPINTF=^TMP("MPIFVQQ",$J,CNTR,"TF",MPINTFI)
- .. S TFIEN=$$IEN^XUAF4($P(MPINTF,MPICOMP,1))
- .. Q:'TFIEN
- .. S TFSTRG=TFIEN_"^"_$$FMDATE^HLFNC($P(MPINTF,MPICOMP,2))_"^"_$P(MPINTF,MPICOMP,3)
- .. D FILE^VAFCTFU(PATID,TFSTRG,1)
- . ;**58 MVI 2593 To trigger the Patient Record Flag process as in DGREG and DG10
- . N PRF S PRF=$$EN1^DGPFMPI(PATID)
- S RESLT=$$A24^MPIFA24B(PATID)
- ;**68, Story 827754 (jfw) - Remove Duplicate A31 Logic (A24 call also sending A31)
- I +RESLT<0 D EXC^RGHLLOG(208,"Problem building A24 (ADD TF) for DFN= "_PATID,PATID)
- ;K RESLT N RESLT
- ;S RESLT=$$A31^MPIFA31B(PATID)
- ;I +RESLT<0 D EXC^RGHLLOG(208,"Problem building A31 for DFN= "_PATID,PATID)
- K ^TMP("MPIFVQQ",$J)
- Q
- FINDHM(PATID,SEP,MPIY,MPIMSG,CNTR) ;LOOKUP
- N DIC,X,Y,NM,YTMP,MPIN,EXACT
- Q:'$D(^TMP("MPIFVQQ",$J,CNTR,"DATA"))
- ;added I to DIC(0) allow processing of sensitive patients when DUZ=0
- S DGSENFLG="",DIC="^DPT(",DIC(0)="OISZ",X="`"_PATID D ^DIC K DIC
- S YTMP=Y
- I YTMP=-1 S ^XTMP($J,"MPIF","MSHERR")="LOOKUP FAILED" D EXC^RGHLLOG(210,"SSN = "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3)_" MESSAGE# "_MPIMSG_" around line number "_(CNTR*2),PATID)
- Q:YTMP=-1
- S NM=$P(Y(0),"^"),YTMP=$G(Y(0)),MPIY=Y ; check if ICN already populated
- N ICN S ICN=$$GETICN^MPIF001(PATID)
- I +ICN'=-1,$E(+ICN,1,3)'=$P($$SITE^VASITE,"^",3) S ^XTMP($J,"MPIF","MSHERR")="Patient "_PATID_" Already has an ICN"
- Q:$D(^XTMP($J,"MPIF","MSHERR"))
- S Y(0)=$G(YTMP)
- ;**43 ONLY EXACT MATCHES BEING RETURNED NO LONGER MAKE THESE CHECKES IN VISTA
- ;Q:$P(Y(0),"^",9)["P"&($P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3)="")
- ;I $P(Y(0),"^",9)'=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3) D
- ;.S ^XTMP($J,"MPIF","MSHERR")="SSN MISMATCH"
- ;.D EXC^RGHLLOG(213,"SSN on File = "_$P(Y(0),"^",9)_" SSN in Message = "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3)_" MESSAGE # "_MPIMSG_" around line number "_(CNTR*2),PATID)
- ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ; create local ICN
- ;Q:$D(^XTMP($J,"MPIF","MSHERR"))
- ;D NAME^VAFCPID2(0,.NM,0) ; reformat name in DG 149 fashion for comparison
- ;S MPIN=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",2)_","_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",7)
- ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)
- ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",15)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",15)
- ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",14)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",14)
- ;D NAME^VAFCPID2(0,.MPIN,0)
- ; check if Last and First Match--yes-- then check if middle name vs initial
- ;I $P(NM,",")=$P(MPIN,",")&($P($P(MPIN,",",2)," ")=$P($P(NM,",",2)," ")) D
- ;.N MPIMID,NMMN S MPIMID=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)
- ;.S NMMN=$P($P(NM,",",2)," ",2)
- ;.I $L(NMMN)>1&($L(MPIMID)=1),($E(NMMN,1)=MPIMID) S EXACT=1
- ;.I $L(MPIMID)>1&($L(NMMN)=1),($E(MPIMID,1)=NMMN) S EXACT=1
- ;I NM'=MPIN,'$D(EXACT) D
- ;.S ^XTMP($J,"MPIF","MSHERR")="NAME MISMATCH"
- ;.D EXC^RGHLLOG(214,"Name on File = "_$P(Y(0),"^")_" Name in Message = "_MPIN_" MESSAGE# "_MPIMSG_" around line number "_(CNTR*2),PATID)
- ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ;create local ICN
- ;check to see if SEX on MPI and local site match - no exception
- ;I $P($G(^DPT(PATID,0)),"^",2)'=$P($G(^TMP("MPIFVQQ",$J,CNTR,"DATA")),"^",11) D
- ;.S ^XTMP($J,"MPIF","MSHERR")="SEX MISMATCH"
- ;.D EXC^RGHLLOG(209,"PT on MPI "_MPIN_" has gender as "_$P($G(^TMP("MPIFVQQ",$J,CNTR,"DATA")),"^",10)_" While the Patient DFN= "_PATID_" has "_$P($G(^DPT(PATID,0)),"^",2)_" msg # "_MPIMSG_" about line number "_(CNTR*2),PATID)
- ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ;create local ICN
- ;
- ;check to see if MPI has Date of Death or if VistA has DOD
- ;N MPIDTH,VISTDTH K %DT
- ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",9)'="" S X=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",9) D ^%DT S MPIDTH=Y
- ;I $D(^DPT(PATID,.35)),$P($G(^DPT(PATID,.35)),"^")'="" S VISTDTH=$P($G(^DPT(PATID,.35)),"^")\1
- ;I $D(MPIDTH)&$D(VISTDTH),MPIDTH'=VISTDTH D
- ;.N Y S Y=MPIDTH D DD^%DT S MPIDTH=Y,Y=VISTDTH D DD^%DT S VISTDTH=Y
- ;.D EXC^RGHLLOG(217,"Around line "_(CNTR*2)_" VISTA DOD= "_VISTDTH_" MPI DOD= "_MPIDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- ; ^ BOTH HAVE DOD BUT THEY DON'T MATCH
- ;I '$D(MPIDTH)&($D(VISTDTH)) D
- ;.N Y S Y=VISTDTH D DD^%DT S VISTDTH=Y
- ;.D EXC^RGHLLOG(216,"Around line "_(CNTR*2)_" VISTA DOD= "_VISTDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- ; ^ VISTA HAS DOD BUT MPI DOESN'T
- ;I $D(MPIDTH)&('$D(VISTDTH)) D
- ;.N Y S Y=MPIDTH D DD^%DT S MPIDTH=Y
- ;.D EXC^RGHLLOG(215,"Around line "_(CNTR*2)_" MPI DOD= "_MPIDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- ; ^ MPI HAS DOD BUT VISTA DOESN'T
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMPIFBT3 7141 printed Feb 18, 2025@23:37:14 Page 2
- MPIFBT3 ;SLC/ARS-BATCH RESPONSE FROM MPI ;FEB 4, 1997
- +1 ;;1.0;MASTER PATIENT INDEX VISTA;**1,3,10,17,21,24,28,31,33,35,43,52,58,60,68**;30 Apr 99;Build 2
- +2 ;
- +3 ; Integration Agreements Utilized:
- +4 ; ^DPT("AICN", ^DPT("AICNL", ^DPT("AMPIMIS" - #2070
- +5 ; EXC^RGHLLOG - #2796
- +6 ; FILE^VAFCTFU - #2988
- +7 ; NAME^VAFCPID2 - #3492
- +8 ; EN1^DGPFMPI - #6002
- +9 ;
- MULT(CNTR,ACK5,SEP,MPIMSG,PATID) ;multiple RDT segments
- +1 NEW NEXTTF,MPITMP
- SET CNTR=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
- SET NEXTTF=$PIECE(ACK5,SEP,8)
- +2 SET MPITMP=$ORDER(^XTMP($JOB,"MPIF","MPIIN",CNTR))
- if MPITMP'>0
- QUIT
- +3 SET ACK5=^XTMP($JOB,"MPIF","MPIIN",MPITMP)
- KILL NEXTTF,MPITMP
- +4 ; ^ add to treating facility list. If not RDT continue on processing next msh
- IF $PIECE(ACK5,SEP)="RDT"
- DO MULT(.CNTR,ACK5,SEP,MPIMSG,PATID)
- +5 QUIT
- VFYRDT(ACK4,SEP,CNTR,PATID,SITE,MPIMSG) ;Here is the meat
- +1 NEW MPIY,IEN,MPICMOR,MPICOMP
- SET DGSENFLG=""
- +2 SET MPICOMP=$EXTRACT(HL("ECH"),1)
- +3 DO RDT^MPIFSA3(.CNTR,.HL,.ACK4)
- +4 DO FINDHM(PATID,SEP,.MPIY,MPIMSG,CNTR)
- +5 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
- QUIT
- +6 NEW MPINUM,MPICKG,MPIIT,DR,DIE,X,MPIIPPF,MPIPPF,RESLT,MPIFICN
- +7 SET MPIFICN=$PIECE(^TMP("MPIFVQQ",$JOB,CNTR,"DATA"),"^",6)
- SET MPICKG=$PIECE(MPIFICN,"V",2)
- SET MPINUM=$PIECE(MPIFICN,"V",1)
- +8 ;check if ICN already in use in Patient file
- +9 IF $DATA(^DPT("AICN",MPINUM))
- Begin DoDot:1
- +10 ; same patient
- if PATID=$ORDER(^DPT("AICN",MPINUM,""))
- QUIT
- +11 SET ^XTMP($JOB,"MPIF","MSHERR")="ICN already in use"
- +12 NEW DFN2
- SET DFN2=$ORDER(^DPT("AICN",MPINUM,""))
- +13 DO TWODFNS^MPIF002(DFN2,PATID,MPINUM)
- +14 ;**52 need to trigger A28 add as if not found
- +15 SET MPIFRPC=1
- DO A28^MPIFQ3(PATID)
- KILL MPIFRPC
- End DoDot:1
- +16 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
- QUIT
- +17 ;**60 (elz) MVI_793 need to store full ICN in new field
- +18 SET DIE="^DPT("
- SET DA=$PIECE(MPIY,"^",1)
- SET MPIIT=$PIECE(MPIY,"^",1)
- SET DR="991.01////^S X=MPINUM;991.02////^S X=MPICKG;991.1////^S X=MPIFICN"
- DO ^DIE
- KILL DR,DIE,DA
- +19 ; check if need to kill Local/MISSING ICN field
- SET IEN=$PIECE(MPIY,"^")
- +20 IF $DATA(^DPT("AMPIMIS",IEN))
- KILL ^DPT("AMPIMIS",IEN)
- +21 IF $DATA(^DPT("AICNL",1,IEN))
- Begin DoDot:1
- +22 SET DIE="^DPT("
- SET DA=IEN
- SET DR="991.04///@"
- DO ^DIE
- KILL DR,DIE,DA
- End DoDot:1
- +23 SET MPIIPPF=""
- +24 SET MPIPPF=$PIECE(^TMP("MPIFVQQ",$JOB,CNTR,"DATA"),"^",5)
- SET MPICMOR=$$LKUP^XUAF4(MPIPPF)
- +25 IF MPICMOR'=""
- SET MPIIPPF=$$CHANGE^MPIF001(MPIIT,MPICMOR)
- +26 IF +MPIIPPF<0
- DO EXC^RGHLLOG(211,"Around line number "_(CNTR*2)_" CMOR= "_MPIPPF_" DFN= "_MPIIT_" MESSAGE# "_MPIMSG,MPIIT)
- +27 if +MPIIPPF<0
- QUIT
- +28 IF $DATA(^TMP("MPIFVQQ",$JOB,CNTR,"TF"))
- Begin DoDot:1
- +29 NEW MPINTFI,MPINTF,TFSTRG,TFIEN
- +30 SET MPINTFI=0
- SET MPINTF=""
- SET TFIEN=""
- SET TFSTRG=""
- +31 FOR
- SET MPINTFI=$ORDER(^TMP("MPIFVQQ",$JOB,CNTR,"TF",MPINTFI))
- if 'MPINTFI
- QUIT
- Begin DoDot:2
- +32 SET MPINTF=^TMP("MPIFVQQ",$JOB,CNTR,"TF",MPINTFI)
- +33 SET TFIEN=$$IEN^XUAF4($PIECE(MPINTF,MPICOMP,1))
- +34 if 'TFIEN
- QUIT
- +35 SET TFSTRG=TFIEN_"^"_$$FMDATE^HLFNC($PIECE(MPINTF,MPICOMP,2))_"^"_$PIECE(MPINTF,MPICOMP,3)
- +36 DO FILE^VAFCTFU(PATID,TFSTRG,1)
- End DoDot:2
- +37 ;**58 MVI 2593 To trigger the Patient Record Flag process as in DGREG and DG10
- +38 NEW PRF
- SET PRF=$$EN1^DGPFMPI(PATID)
- End DoDot:1
- +39 SET RESLT=$$A24^MPIFA24B(PATID)
- +40 ;**68, Story 827754 (jfw) - Remove Duplicate A31 Logic (A24 call also sending A31)
- +41 IF +RESLT<0
- DO EXC^RGHLLOG(208,"Problem building A24 (ADD TF) for DFN= "_PATID,PATID)
- +42 ;K RESLT N RESLT
- +43 ;S RESLT=$$A31^MPIFA31B(PATID)
- +44 ;I +RESLT<0 D EXC^RGHLLOG(208,"Problem building A31 for DFN= "_PATID,PATID)
- +45 KILL ^TMP("MPIFVQQ",$JOB)
- +46 QUIT
- FINDHM(PATID,SEP,MPIY,MPIMSG,CNTR) ;LOOKUP
- +1 NEW DIC,X,Y,NM,YTMP,MPIN,EXACT
- +2 if '$DATA(^TMP("MPIFVQQ",$JOB,CNTR,"DATA"))
- QUIT
- +3 ;added I to DIC(0) allow processing of sensitive patients when DUZ=0
- +4 SET DGSENFLG=""
- SET DIC="^DPT("
- SET DIC(0)="OISZ"
- SET X="`"_PATID
- DO ^DIC
- KILL DIC
- +5 SET YTMP=Y
- +6 IF YTMP=-1
- SET ^XTMP($JOB,"MPIF","MSHERR")="LOOKUP FAILED"
- DO EXC^RGHLLOG(210,"SSN = "_$PIECE(^TMP("MPIFVQQ",$JOB,CNTR,"DATA"),"^",3)_" MESSAGE# "_MPIMSG_" around line number "_(CNTR*2),PATID)
- +7 if YTMP=-1
- QUIT
- +8 ; check if ICN already populated
- SET NM=$PIECE(Y(0),"^")
- SET YTMP=$GET(Y(0))
- SET MPIY=Y
- +9 NEW ICN
- SET ICN=$$GETICN^MPIF001(PATID)
- +10 IF +ICN'=-1
- IF $EXTRACT(+ICN,1,3)'=$PIECE($$SITE^VASITE,"^",3)
- SET ^XTMP($JOB,"MPIF","MSHERR")="Patient "_PATID_" Already has an ICN"
- +11 if $DATA(^XTMP($JOB,"MPIF","MSHERR"))
- QUIT
- +12 SET Y(0)=$GET(YTMP)
- +13 ;**43 ONLY EXACT MATCHES BEING RETURNED NO LONGER MAKE THESE CHECKES IN VISTA
- +14 ;Q:$P(Y(0),"^",9)["P"&($P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3)="")
- +15 ;I $P(Y(0),"^",9)'=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3) D
- +16 ;.S ^XTMP($J,"MPIF","MSHERR")="SSN MISMATCH"
- +17 ;.D EXC^RGHLLOG(213,"SSN on File = "_$P(Y(0),"^",9)_" SSN in Message = "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",3)_" MESSAGE # "_MPIMSG_" around line number "_(CNTR*2),PATID)
- +18 ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ; create local ICN
- +19 ;Q:$D(^XTMP($J,"MPIF","MSHERR"))
- +20 ;D NAME^VAFCPID2(0,.NM,0) ; reformat name in DG 149 fashion for comparison
- +21 ;S MPIN=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",2)_","_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",7)
- +22 ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)
- +23 ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",15)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",15)
- +24 ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",14)'="" S MPIN=MPIN_" "_$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",14)
- +25 ;D NAME^VAFCPID2(0,.MPIN,0)
- +26 ; check if Last and First Match--yes-- then check if middle name vs initial
- +27 ;I $P(NM,",")=$P(MPIN,",")&($P($P(MPIN,",",2)," ")=$P($P(NM,",",2)," ")) D
- +28 ;.N MPIMID,NMMN S MPIMID=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",10)
- +29 ;.S NMMN=$P($P(NM,",",2)," ",2)
- +30 ;.I $L(NMMN)>1&($L(MPIMID)=1),($E(NMMN,1)=MPIMID) S EXACT=1
- +31 ;.I $L(MPIMID)>1&($L(NMMN)=1),($E(MPIMID,1)=NMMN) S EXACT=1
- +32 ;I NM'=MPIN,'$D(EXACT) D
- +33 ;.S ^XTMP($J,"MPIF","MSHERR")="NAME MISMATCH"
- +34 ;.D EXC^RGHLLOG(214,"Name on File = "_$P(Y(0),"^")_" Name in Message = "_MPIN_" MESSAGE# "_MPIMSG_" around line number "_(CNTR*2),PATID)
- +35 ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ;create local ICN
- +36 ;check to see if SEX on MPI and local site match - no exception
- +37 ;I $P($G(^DPT(PATID,0)),"^",2)'=$P($G(^TMP("MPIFVQQ",$J,CNTR,"DATA")),"^",11) D
- +38 ;.S ^XTMP($J,"MPIF","MSHERR")="SEX MISMATCH"
- +39 ;.D EXC^RGHLLOG(209,"PT on MPI "_MPIN_" has gender as "_$P($G(^TMP("MPIFVQQ",$J,CNTR,"DATA")),"^",10)_" While the Patient DFN= "_PATID_" has "_$P($G(^DPT(PATID,0)),"^",2)_" msg # "_MPIMSG_" about line number "_(CNTR*2),PATID)
- +40 ;.N LICN S LICN=$$ICNLC^MPIF001(PATID) ;create local ICN
- +41 ;
- +42 ;check to see if MPI has Date of Death or if VistA has DOD
- +43 ;N MPIDTH,VISTDTH K %DT
- +44 ;I $P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",9)'="" S X=$P(^TMP("MPIFVQQ",$J,CNTR,"DATA"),"^",9) D ^%DT S MPIDTH=Y
- +45 ;I $D(^DPT(PATID,.35)),$P($G(^DPT(PATID,.35)),"^")'="" S VISTDTH=$P($G(^DPT(PATID,.35)),"^")\1
- +46 ;I $D(MPIDTH)&$D(VISTDTH),MPIDTH'=VISTDTH D
- +47 ;.N Y S Y=MPIDTH D DD^%DT S MPIDTH=Y,Y=VISTDTH D DD^%DT S VISTDTH=Y
- +48 ;.D EXC^RGHLLOG(217,"Around line "_(CNTR*2)_" VISTA DOD= "_VISTDTH_" MPI DOD= "_MPIDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- +49 ; ^ BOTH HAVE DOD BUT THEY DON'T MATCH
- +50 ;I '$D(MPIDTH)&($D(VISTDTH)) D
- +51 ;.N Y S Y=VISTDTH D DD^%DT S VISTDTH=Y
- +52 ;.D EXC^RGHLLOG(216,"Around line "_(CNTR*2)_" VISTA DOD= "_VISTDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- +53 ; ^ VISTA HAS DOD BUT MPI DOESN'T
- +54 ;I $D(MPIDTH)&('$D(VISTDTH)) D
- +55 ;.N Y S Y=MPIDTH D DD^%DT S MPIDTH=Y
- +56 ;.D EXC^RGHLLOG(215,"Around line "_(CNTR*2)_" MPI DOD= "_MPIDTH_" DFN= "_PATID_" MESSAGE# "_MPIMSG,PATID)
- +57 ; ^ MPI HAS DOD BUT VISTA DOESN'T
- +58 QUIT
