source: FOIAVistA/tag/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGADTP2.m@ 1410

RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02  10:04
 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48**;30 Apr 99;Build 3
DBIA ;
 ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
 ;Reference to EDIT^VAFCPTED supported by IA #2784
 Q
PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
 N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,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"
 Q:$G(RGER)
 I $G(OTHSITE)="" S OTHSITE=""
 S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
 S ICN=$P(NODE,"^")
 S CMORIEN=$P(NODE,"^",3)
 S CMOR=$$NS^XUAF4(CMORIEN)
 S CMORDISP=$P(CMOR,"^",1)
 S CMOR=$P(CMOR,"^",2)
 ;
 ;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)
 ;
 ;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
 .;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
 .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")
 .;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
 .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
 ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
 ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
 ..N DR,ARAY2 S RGER=""
 ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
 ..I DR'="" D
 ...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),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")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
 ...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
 ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
 ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
 ...;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,SSNV,MBI
 ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
 ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
 ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
 ...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 PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
 ...;**48
 ...I SSN["P" D
 ....;if pseudo SSN reason field has been added to the DD then attempt to set it
 ....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
 .....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
 .....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
 .....I PS=""&(ARAY2(2,.0906)="@") Q
 .....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
 .....I PS=ARAY2(2,.0906) D
 ......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
 ......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
 ......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
 ......S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
 ...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
 ....I $G(ARRAY("SSN"))="P",SSN["P" Q  ;**47 NEEDED TO CREATE PSEUDO AND DID
 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
 ...I SSN=$G(ARRAY("SSN")) D
 ....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
 ....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
 .....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
 .....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
 .....S:$G(ARRAY(.0907))="@" ARRAY(.0907)="" I SSNV'=$G(ARRAY(.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
 .....I SSNV'="" D
 ......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
 ......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
 ......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
 ......I PS=""&(ARAY2(2,.0906)="@") Q
 ......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
 ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX 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"
 ...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
 ...I MBI'=$G(ARRAY("MBI")) D
 ....Q:MBI=""&($G(ARRAY("MBI"))="@")  ;**47 "" AND @ ARE THE SAME
 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
 ...;send the updated fields to the MPI to synch site with MPI
 ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
 ...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
 Q