Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RGADTP2

RGADTP2.m

Go to the documentation of this file.
  1. 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
  1. DBIA ;
  1. ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
  1. ;Reference to EDIT^VAFCPTED supported by IA #2784
  1. ;Reference to ^DPT(DFN,.105) supported by IA #10035
  1. Q
  1. PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
  1. N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
  1. S REP=$E(HL("ECH"),2)
  1. S HERE=$P($$SITE^VASITE,"^",3)
  1. ;if sending site is your site quit
  1. Q:$G(ARRAY("MPISSITE"))=$G(HERE)
  1. S ARRAY(.097)=$P($$NOW^XLFDT,".")
  1. I $G(ARRAY("ICN"))'="" D
  1. .S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q ;quit and return error msg
  1. .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
  1. I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
  1. I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
  1. I $G(RGER) Q
  1. I $G(OTHSITE)="" S OTHSITE=""
  1. S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
  1. S ICN=$P(NODE,"^")
  1. S CMORIEN=$P(NODE,"^",3)
  1. ;
  1. ;**58,MPIC_2416: If there is no CMOR for the patient, set CMOR to "".
  1. ; Prevents SUBSCRIPT error that occurs if "" is passed to $$NS^XUAF4.
  1. S CMOR=$S(CMORIEN:$P($$NS^XUAF4(CMORIEN),"^",2),1:"")
  1. ;
  1. ;If patient is Sensitive at other site but not here send bulletin
  1. I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
  1. .N NAME S NAME=ARRAY("NAME")
  1. .I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
  1. ..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
  1. ..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
  1. ..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
  1. ;
  1. ;MPIC_772 - **52; Commented out Remote Date of Death Indicated section.
  1. ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
  1. ;Ignore time if present with date.
  1. ;S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
  1. ;S DFN=RGRSDFN D DEM^VADPT
  1. ;S LOCDOD=$P($P(VADM(6),"^"),".")
  1. ;If there is a remote DOD but no local DOD OR if remote DOD is different from local DOD, send bulletin
  1. ;I RMTDOD D
  1. ;.N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
  1. ;.D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
  1. ;K VADM
  1. ;
  1. NOTLOC I 'RGLOCAL D
  1. .;**45 if sending site is NOT the CMOR and NOT the MPI - log update into PDR if differences exist
  1. .;**49 stop logging entries into PDR
  1. .;I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D Q
  1. .;.S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
  1. .;.S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
  1. .;.S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
  1. .;.S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
  1. .;.N ARAY M ARAY(2)=ARRAY
  1. .;.S VAFCA08=1 ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
  1. .;
  1. .;**45 if sending site is the CMOR OR MPI - synchronize data
  1. .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
  1. ..I HL("ETN")="A31",$G(RGRSDFN)>0 K ^XTMP("MPIF OLD RECORDS",RGRSDFN) ;**59,MVI_914: Delete the old record designation
  1. ..;**66 - Story 349269 (ckn) - Moved below two lines here from below
  1. ..;to check the differences in field values before checking Inpatient
  1. ..;status and outstanding edit in the ADT/HL7 PIVOT file
  1. ..N DR,ARAY2,INPFLG
  1. ..S RGER="",INPFLG=0
  1. ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARAY) ;check for differences ;**59, MVI_881 4th parameter to be 'ARAY'
  1. ..;
  1. ..;**RG*1.0*64/Story 220139 (cml): check for inpatient status, stop update if
  1. ..;patient is currently an inpatient, could cause confusion with treatment if
  1. ..;wristband doesn't match VistA
  1. ..;**RG*1.0*66 - Story 349269 (ckn) - Inpatient Edits pending request shall
  1. ..;only be logged in TK if ID traits-Name, DOB, Gender, SSN or Date of Death
  1. ..;is changed. Also, it should not log unless MBI is getting set to "Yes".
  1. ..;By setting RGER the App Ack will contain "is currently an Inpatient," and
  1. ..;the MPI will see that and log a #6230 request type to TK.
  1. ..I $G(^DPT(RGRSDFN,.105)) D ;patient is an inpatient
  1. ...I DR="" Q ;No edit **72 (cmc) story 1104673 changed name from .01 to 1.01 \/ from patch 71 change to name
  1. ...N I F I="1.01",".02",".03",".09",".351" I (";"_DR)[(";"_I_";") S INPFLG=1 Q
  1. ...I ((";"_DR)[(";"_994_";")),($G(ARRAY("MBI"))="Y") S INPFLG=1 Q
  1. ..I INPFLG S RGER="-1^DFN "_RGRSDFN_": is currently an Inpatient, MPI update not processed." I +RGER<0 Q
  1. ..;
  1. ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
  1. ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) I +RGER<0 Q
  1. ..;
  1. ..S RGER="" ;**67, Story 445418 (jfw) Set RGER to "" if 0 returned so that error can be returned in AA.
  1. ..I DR'="" D
  1. ...S VAFCA08=1 ;used by ^DD's to stop add to adt/hl7 pivot (#391.71) file
  1. ...S ARAY(2,.01)=ARRAY("NAME")
  1. ...S ARAY(2,.03)=$G(ARRAY("MPIDOB"))
  1. ...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
  1. ...S ARAY(2,.02)=$G(ARRAY("SEX"))
  1. ...S ARAY(2,.2403)=$G(ARRAY("MMN"))
  1. ...S ARAY(2,994)=$G(ARRAY("MBI"))
  1. ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 add alias to mix
  1. ...I $D(ARRAY("SexOr")) M ARAY(2,.025)=ARRAY("SexOr") ;**76, VAMPI-11114 (dri)
  1. ...I $D(ARRAY("Pronoun")) M ARAY(2,.2406)=ARRAY("Pronoun") ;**76, VAMPI-11118 (dri)
  1. ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR) ;file differences into patient file
  1. ...;
  1. ...;check to see if edits were successful, if not set RGER="why it failed"
  1. ...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,MBI
  1. ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I")
  1. ...S PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
  1. ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I")
  1. ...S SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
  1. ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I")
  1. ...S MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
  1. ...;
  1. ...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
  1. ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
  1. ...I MBI'=$G(ARRAY("MBI")) D
  1. ....I MBI=""&($G(ARRAY("MBI"))="@") Q
  1. ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
  1. ...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"
  1. ...;
  1. ...;**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
  1. ...I '$$GETFLAG^MPIFNAMC D
  1. ....D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
  1. ....I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
  1. ...;
  1. ...I SSN'=$G(ARRAY("SSN")),$G(ARRAY("SSN"))'="",$G(ARRAY("SSN"))'="@" D ;**54 mpic_1556 added array("ssn")'="@"
  1. ....I $G(ARRAY("SSN"))="P",SSN["P" Q ;**47 need to create a pseudo ssn and did create one
  1. ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
  1. ...;
  1. ...;**48 only set ssn verification status and pseudo ssn reason if ssn update successful
  1. ...I SSN["P" D ;either ssn just became a pseudo or it was already a pseudo and the update to a real ssn failed
  1. ....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
  1. ....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
  1. ....;
  1. ....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
  1. .....N PSNR S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
  1. .....I PSNR=""&(ARRAY(.0906)="@") Q
  1. .....I PSNR=ARRAY(.0906) Q
  1. .....K ARAY2 S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
  1. .....S PSNR=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
  1. .....I PSNR=""&(ARAY2(2,.0906)="@") Q
  1. .....I PSNR'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
  1. ...;
  1. ...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
  1. ....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
  1. ....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
  1. ....;
  1. ....N SSNV S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I") ;update ssnv if different from local
  1. ....I SSNV=""&(ARRAY(.0907)="@") Q
  1. ....I SSNV=ARRAY(.0907) Q
  1. ....K ARAY2 S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
  1. ....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
  1. ....I SSNV=""&(ARAY2(2,.0907)="@") Q
  1. ....I SSNV'=$G(ARAY2(2,.0907)) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN VERIFICATION field failure"
  1. ...;
  1. ...;**45 don't trigger A31 sync message if A31 was being processed - ack to a31 will sync id elements on MPI
  1. ...;send the updated fields to the MPI to synch the correlation on the MPI when site receives update from cmor
  1. ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
  1. Q
  1. ;