RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;8/17/21 15:36
;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48,49,52,54,58,59,64,66,67,71,72,76**;30 Apr 99;Build 1
DBIA ;
;Reference to $$ADD^VAFCEHU1 supported by IA #2753
;Reference to EDIT^VAFCPTED supported by IA #2784
;Reference to ^DPT(DFN,.105) supported by IA #10035
Q
PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
S REP=$E(HL("ECH"),2)
S HERE=$P($$SITE^VASITE,"^",3)
;if sending site is your site quit
Q:$G(ARRAY("MPISSITE"))=$G(HERE)
S ARRAY(.097)=$P($$NOW^XLFDT,".")
I $G(ARRAY("ICN"))'="" D
.S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q ;quit and return error msg
.S OTHSITE=ARRAY("SENDING SITE") ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
I $G(RGER) Q
I $G(OTHSITE)="" S OTHSITE=""
S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
S ICN=$P(NODE,"^")
S CMORIEN=$P(NODE,"^",3)
;
;**58,MPIC_2416: If there is no CMOR for the patient, set CMOR to "".
; Prevents SUBSCRIPT error that occurs if "" is passed to $$NS^XUAF4.
S CMOR=$S(CMORIEN:$P($$NS^XUAF4(CMORIEN),"^",2),1:"")
;
;If patient is Sensitive at other site but not here send bulletin
I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
.N NAME S NAME=ARRAY("NAME")
.I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
;
;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
;If patient has DATE OF DEATH (DOD) at remote site send bulletin
;Ignore time if present with date.
;S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
;S DFN=RGRSDFN D DEM^VADPT
;S LOCDOD=$P($P(VADM(6),"^"),".")
;If there is a remote DOD but no local DOD OR if remote DOD is different from local DOD, send bulletin
;I RMTDOD D
;.N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
;.D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
;K VADM
;
NOTLOC I 'RGLOCAL D
.;**45 if sending site is NOT the CMOR and NOT the MPI - log update into PDR if differences exist
.;**49 stop logging entries into PDR
.;I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D Q
.;.S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
.;.S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
.;.S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
.;.S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
.;.N ARAY M ARAY(2)=ARRAY
.;.S VAFCA08=1 ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
.;
.;**45 if sending site is the CMOR OR MPI - synchronize data
.I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
..I HL("ETN")="A31",$G(RGRSDFN)>0 K ^XTMP("MPIF OLD RECORDS",RGRSDFN) ;**59,MVI_914: Delete the old record designation
..;**66 - Story 349269 (ckn) - Moved below two lines here from below
..;to check the differences in field values before checking Inpatient
..;status and outstanding edit in the ADT/HL7 PIVOT file
..N DR,ARAY2,INPFLG
..S RGER="",INPFLG=0
..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARAY) ;check for differences ;**59, MVI_881 4th parameter to be 'ARAY'
..;
..;**RG*1.0*64/Story 220139 (cml): check for inpatient status, stop update if
..;patient is currently an inpatient, could cause confusion with treatment if
..;wristband doesn't match VistA
..;**RG*1.0*66 - Story 349269 (ckn) - Inpatient Edits pending request shall
..;only be logged in TK if ID traits-Name, DOB, Gender, SSN or Date of Death
..;is changed. Also, it should not log unless MBI is getting set to "Yes".
..;By setting RGER the App Ack will contain "is currently an Inpatient," and
..;the MPI will see that and log a #6230 request type to TK.
..I $G(^DPT(RGRSDFN,.105)) D ;patient is an inpatient
...I DR="" Q ;No edit **72 (cmc) story 1104673 changed name from .01 to 1.01 \/ from patch 71 change to name
...N I F I="1.01",".02",".03",".09",".351" I (";"_DR)[(";"_I_";") S INPFLG=1 Q
...I ((";"_DR)[(";"_994_";")),($G(ARRAY("MBI"))="Y") S INPFLG=1 Q
..I INPFLG S RGER="-1^DFN "_RGRSDFN_": is currently an Inpatient, MPI update not processed." I +RGER<0 Q
..;
..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
..S RGER=$$CHKPVT^RGADTP3(.ARRAY) I +RGER<0 Q
..;
..S RGER="" ;**67, Story 445418 (jfw) Set RGER to "" if 0 returned so that error can be returned in AA.
..I DR'="" D
...S VAFCA08=1 ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
...S ARAY(2,.01)=ARRAY("NAME")
...S ARAY(2,.03)=$G(ARRAY("MPIDOB"))
...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
...S ARAY(2,.02)=$G(ARRAY("SEX"))
...S ARAY(2,.2403)=$G(ARRAY("MMN"))
...S ARAY(2,994)=$G(ARRAY("MBI"))
...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 add alias to mix
...I $D(ARRAY("SexOr")) M ARAY(2,.025)=ARRAY("SexOr") ;**76, VAMPI-11114 (dri)
...I $D(ARRAY("Pronoun")) M ARAY(2,.2406)=ARRAY("Pronoun") ;**76, VAMPI-11118 (dri)
...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR) ;file differences into patient file
...;
...;check to see if edits were successful, if not set RGER="why it failed"
...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,MBI
...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I")
...S PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I")
...S SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I")
...S MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
...;
...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
...I MBI'=$G(ARRAY("MBI")) D
....I MBI=""&($G(ARRAY("MBI"))="@") Q
....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN) I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
...;
...;**71,Story 841921 (mko): Use this STDNAME method of checking that the name was updated only if the new Name Components flag is not set
...I '$$GETFLAG^MPIFNAMC D
....D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
....I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
...;
...I SSN'=$G(ARRAY("SSN")),$G(ARRAY("SSN"))'="",$G(ARRAY("SSN"))'="@" D ;**54 mpic_1556 added array("ssn")'="@"
....I $G(ARRAY("SSN"))="P",SSN["P" Q ;**47 need to create a pseudo ssn and did create one
....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
...;
...;**48 only set ssn verification status and pseudo ssn reason if ssn update successful
...I SSN["P" D ;either ssn just became a pseudo or it was already a pseudo and the update to a real ssn failed
....N SSNV S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I") I SSNV'="" K ARAY2 S ARAY2(2,.0907)="@",DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR) ;if pseudo ssn then always delete local ssn verification status
....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I") I SSNV'="" S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure" ;if delete doesn't occur log failure
....;
....I $S(ARRAY("SSN")="":1,ARRAY("SSN")="@":1,ARRAY("SSN")="P":1,1:0) D ;if local pseudo ssn reason different from the incoming then update
.....N PSNR S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
.....I PSNR=""&(ARRAY(.0906)="@") Q
.....I PSNR=ARRAY(.0906) Q
.....K ARAY2 S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
.....S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
.....I PSNR=""&(ARAY2(2,.0906)="@") Q
.....I PSNR'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
...;
...I SSN=$G(ARRAY("SSN")) D ;we've got a real ssn, real ssn update would only fail if a duplicate ssn already at site, then no updating would occur
....N PSNR S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I") I PSNR'="" K ARAY2 S ARAY2(2,.0906)="@",DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR) ;if real ssn delete local pseudo ssn reason
....S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I") I PSNR'="" S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure" ;if delete doesn't occur log failure
....;
....N SSNV S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I") ;update ssnv if different from local
....I SSNV=""&(ARRAY(.0907)="@") Q
....I SSNV=ARRAY(.0907) Q
....K ARAY2 S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
....I SSNV=""&(ARAY2(2,.0907)="@") Q
....I SSNV'=$G(ARAY2(2,.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
...;
...;**45 don't trigger A31 sync message if A31 was being processed - ack to a31 will sync id elements on MPI
...;send the updated fields to the MPI to synch the correlation on the MPI when site receives update from cmor
...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGADTP2 10054 printed Oct 16, 2024@17:42:16 Page 2
RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;8/17/21 15:36
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48,49,52,54,58,59,64,66,67,71,72,76**;30 Apr 99;Build 1
DBIA ;
+1 ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
+2 ;Reference to EDIT^VAFCPTED supported by IA #2784
+3 ;Reference to ^DPT(DFN,.105) supported by IA #10035
+4 QUIT
PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
+1 NEW RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
+2 SET REP=$EXTRACT(HL("ECH"),2)
+3 SET HERE=$PIECE($$SITE^VASITE,"^",3)
+4 ;if sending site is your site quit
+5 if $GET(ARRAY("MPISSITE"))=$GET(HERE)
QUIT
+6 SET ARRAY(.097)=$PIECE($$NOW^XLFDT,".")
+7 IF $GET(ARRAY("ICN"))'=""
Begin DoDot:1
+8 ;quit and return error msg
SET RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN"))
IF +RGRSDFN<1
SET RGER=RGRSDFN_" ICN#"_$GET(ARRAY("ICN"))
QUIT
+9 ;**40 REMOVED THE PLUS TO KEEP SUFFIX ON STATION# & CHANGED THE SITE TO BE SENDING SITE INSTEAD OF AUTHORITATIVE SOURCE
SET OTHSITE=ARRAY("SENDING SITE")
End DoDot:1
+10 IF $GET(RGRSDFN)=""
SET RGRSDFN=$GET(DFN)
+11 IF $GET(RGRSDFN)=""
SET RGER="-1^DFN not defined"
+12 IF $GET(RGER)
QUIT
+13 IF $GET(OTHSITE)=""
SET OTHSITE=""
+14 SET NODE=$$MPINODE^MPIFAPI(RGRSDFN)
+15 SET ICN=$PIECE(NODE,"^")
+16 SET CMORIEN=$PIECE(NODE,"^",3)
+17 ;
+18 ;**58,MPIC_2416: If there is no CMOR for the patient, set CMOR to "".
+19 ; Prevents SUBSCRIPT error that occurs if "" is passed to $$NS^XUAF4.
+20 SET CMOR=$SELECT(CMORIEN:$PIECE($$NS^XUAF4(CMORIEN),"^",2),1:"")
+21 ;
+22 ;If patient is Sensitive at other site but not here send bulletin
+23 IF $GET(ARRAY("SENSITIVITY"))'=""
SET SENSTVTY=$GET(ARRAY("SENSITIVITY"))
Begin DoDot:1
+24 NEW NAME
SET NAME=ARRAY("NAME")
+25 IF '$$SENSTIVE^RGRSENS(RGRSDFN)
IF SENSTVTY
Begin DoDot:2
+26 SET ARAY("SSN")=ARRAY("SSN")
SET ARAY("SENDING SITE")=ARRAY("SENDING SITE")
+27 SET ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER")
SET ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
+28 DO SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
End DoDot:2
End DoDot:1
+29 ;
+30 ;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
+31 ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
+32 ;Ignore time if present with date.
+33 ;S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
+34 ;S DFN=RGRSDFN D DEM^VADPT
+35 ;S LOCDOD=$P($P(VADM(6),"^"),".")
+36 ;If there is a remote DOD but no local DOD OR if remote DOD is different from local DOD, send bulletin
+37 ;I RMTDOD D
+38 ;.N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
+39 ;.D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
+40 ;K VADM
+41 ;
NOTLOC IF 'RGLOCAL
Begin DoDot:1
+1 ;**45 if sending site is NOT the CMOR and NOT the MPI - log update into PDR if differences exist
+2 ;**49 stop logging entries into PDR
+3 ;I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D Q
+4 ;.S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
+5 ;.S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
+6 ;.S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
+7 ;.S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
+8 ;.N ARAY M ARAY(2)=ARRAY
+9 ;.S VAFCA08=1 ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
+10 ;
+11 ;**45 if sending site is the CMOR OR MPI - synchronize data
+12 IF (OTHSITE)=(CMOR)!(OTHSITE="200M")
Begin DoDot:2
+13 ;**59,MVI_914: Delete the old record designation
IF HL("ETN")="A31"
IF $GET(RGRSDFN)>0
KILL ^XTMP("MPIF OLD RECORDS",RGRSDFN)
+14 ;**66 - Story 349269 (ckn) - Moved below two lines here from below
+15 ;to check the differences in field values before checking Inpatient
+16 ;status and outstanding edit in the ADT/HL7 PIVOT file
+17 NEW DR,ARAY2,INPFLG
+18 SET RGER=""
SET INPFLG=0
+19 ;check for differences ;**59, MVI_881 4th parameter to be 'ARAY'
DO DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARAY)
+20 ;
+21 ;**RG*1.0*64/Story 220139 (cml): check for inpatient status, stop update if
+22 ;patient is currently an inpatient, could cause confusion with treatment if
+23 ;wristband doesn't match VistA
+24 ;**RG*1.0*66 - Story 349269 (ckn) - Inpatient Edits pending request shall
+25 ;only be logged in TK if ID traits-Name, DOB, Gender, SSN or Date of Death
+26 ;is changed. Also, it should not log unless MBI is getting set to "Yes".
+27 ;By setting RGER the App Ack will contain "is currently an Inpatient," and
+28 ;the MPI will see that and log a #6230 request type to TK.
+29 ;patient is an inpatient
IF $GET(^DPT(RGRSDFN,.105))
Begin DoDot:3
+30 ;No edit **72 (cmc) story 1104673 changed name from .01 to 1.01 \/ from patch 71 change to name
IF DR=""
QUIT
+31 NEW I
FOR I="1.01",".02",".03",".09",".351"
IF (";"_DR)[(";"_I_";")
SET INPFLG=1
QUIT
+32 IF ((";"_DR)[(";"_994_";"))
IF ($GET(ARRAY("MBI"))="Y")
SET INPFLG=1
QUIT
End DoDot:3
+33 IF INPFLG
SET RGER="-1^DFN "_RGRSDFN_": is currently an Inpatient, MPI update not processed."
IF +RGER<0
QUIT
+34 ;
+35 ;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
+36 SET RGER=$$CHKPVT^RGADTP3(.ARRAY)
IF +RGER<0
QUIT
+37 ;
+38 ;**67, Story 445418 (jfw) Set RGER to "" if 0 returned so that error can be returned in AA.
SET RGER=""
+39 IF DR'=""
Begin DoDot:3
+40 ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
SET VAFCA08=1
+41 SET ARAY(2,.01)=ARRAY("NAME")
+42 SET ARAY(2,.03)=$GET(ARRAY("MPIDOB"))
+43 ;**45 only set SSN to update if it isn't null
IF ARRAY("SSN")'=""
SET ARAY(2,.09)=$GET(ARRAY("SSN"))
+44 SET ARAY(2,.02)=$GET(ARRAY("SEX"))
+45 SET ARAY(2,.2403)=$GET(ARRAY("MMN"))
+46 SET ARAY(2,994)=$GET(ARRAY("MBI"))
+47 ;**48 add alias to mix
IF $DATA(ARRAY("ALIAS"))
MERGE ARAY(2,1)=ARRAY("ALIAS")
+48 ;**76, VAMPI-11114 (dri)
IF $DATA(ARRAY("SexOr"))
MERGE ARAY(2,.025)=ARRAY("SexOr")
+49 ;**76, VAMPI-11118 (dri)
IF $DATA(ARRAY("Pronoun"))
MERGE ARAY(2,.2406)=ARRAY("Pronoun")
+50 ;file differences into patient file
DO EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
+51 ;
+52 ;check to see if edits were successful, if not set RGER="why it failed"
+53 NEW NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,MBI
+54 SET NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I")
+55 SET PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
+56 SET SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I")
+57 SET SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
+58 SET MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I")
+59 SET MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
+60 ;
+61 IF PDOB'=$GET(ARRAY("MPIDOB"))
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"DOB field failure"
+62 IF SEX'=$GET(ARRAY("SEX"))
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"SEX field failure"
+63 IF MBI'=$GET(ARRAY("MBI"))
Begin DoDot:4
+64 IF MBI=""&($GET(ARRAY("MBI"))="@")
QUIT
+65 SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
End DoDot:4
+66 DO STDNAME^XLFNAME(.MMN,"F",.OLDMMN)
SET HLMMN=ARRAY("MMN")
DO STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
IF MMN'=$GET(HLMMN)
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
+67 ;
+68 ;**71,Story 841921 (mko): Use this STDNAME method of checking that the name was updated only if the new Name Components flag is not set
+69 IF '$$GETFLAG^MPIFNAMC
Begin DoDot:4
+70 DO STDNAME^XLFNAME(.NAME,"F",.OLDNAME)
SET HLNAME=ARRAY("NAME")
DO STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
+71 IF NAME'=$GET(HLNAME)
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"Name field failure"
End DoDot:4
+72 ;
+73 ;**54 mpic_1556 added array("ssn")'="@"
IF SSN'=$GET(ARRAY("SSN"))
IF $GET(ARRAY("SSN"))'=""
IF $GET(ARRAY("SSN"))'="@"
Begin DoDot:4
+74 ;**47 need to create a pseudo ssn and did create one
IF $GET(ARRAY("SSN"))="P"
IF SSN["P"
QUIT
+75 ;**45 only check if SSN is sent isn't null
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"SSN field failure"
End DoDot:4
+76 ;
+77 ;**48 only set ssn verification status and pseudo ssn reason if ssn update successful
+78 ;either ssn just became a pseudo or it was already a pseudo and the update to a real ssn failed
IF SSN["P"
Begin DoDot:4
+79 ;if pseudo ssn then always delete local ssn verification status
NEW SSNV
SET SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
IF SSNV'=""
KILL ARAY2
SET ARAY2(2,.0907)="@"
SET DR=".0907;"
DO EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+80 ;if delete doesn't occur log failure
SET SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
IF SSNV'=""
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
+81 ;
+82 ;if local pseudo ssn reason different from the incoming then update
IF $SELECT(ARRAY("SSN")="":1,ARRAY("SSN")="@":1,ARRAY("SSN")="P":1,1:0)
Begin DoDot:5
+83 NEW PSNR
SET PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
+84 IF PSNR=""&(ARRAY(.0906)="@")
QUIT
+85 IF PSNR=ARRAY(.0906)
QUIT
+86 KILL ARAY2
SET ARAY2(2,.0906)=$GET(ARRAY(.0906))
SET DR=".0906;"
DO EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+87 SET PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
+88 IF PSNR=""&(ARAY2(2,.0906)="@")
QUIT
+89 IF PSNR'=ARAY2(2,.0906)
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
End DoDot:5
End DoDot:4
+90 ;
+91 ;we've got a real ssn, real ssn update would only fail if a duplicate ssn already at site, then no updating would occur
IF SSN=$GET(ARRAY("SSN"))
Begin DoDot:4
+92 ;if real ssn delete local pseudo ssn reason
NEW PSNR
SET PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
IF PSNR'=""
KILL ARAY2
SET ARAY2(2,.0906)="@"
SET DR=".0906;"
DO EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+93 ;if delete doesn't occur log failure
SET PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
IF PSNR'=""
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
+94 ;
+95 ;update ssnv if different from local
NEW SSNV
SET SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
+96 IF SSNV=""&(ARRAY(.0907)="@")
QUIT
+97 IF SSNV=ARRAY(.0907)
QUIT
+98 KILL ARAY2
SET ARAY2(2,.0907)=$GET(ARRAY(.0907))
SET DR=".0907;"
DO EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
+99 SET SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
+100 IF SSNV=""&(ARAY2(2,.0907)="@")
QUIT
+101 IF SSNV'=$GET(ARAY2(2,.0907))
SET RGER=$SELECT($GET(RGER)'="":$GET(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
End DoDot:4
+102 ;
+103 ;**45 don't trigger A31 sync message if A31 was being processed - ack to a31 will sync id elements on MPI
+104 ;send the updated fields to the MPI to synch the correlation on the MPI when site receives update from cmor
+105 IF HL("ETN")'="A31"
SET ZTSAVE("DFN")=""
SET ZTRTN="MPISYN^RGADTPC"
SET ZTDESC="Sending Synchronized Patient Data to MPI..."
SET ZTIO="RG QUEUE"
SET ZTDTH=$HOROLOG
DO ^%ZTLOAD
End DoDot:3
End DoDot:2
End DoDot:1
+106 QUIT
+107 ;
