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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 7.2 KB
Line 
1RGADTP2 ;BIR/DLR-ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS - CONTINUED ;10/30/02 10:04
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**27,20,45,44,47,48,49**;30 Apr 99;Build 1
3DBIA ;
4 ;Reference to $$ADD^VAFCEHU1 supported by IA #2753
5 ;Reference to EDIT^VAFCPTED supported by IA #2784
6 Q
7PROCIN(ARRAY,RGLOCAL,RGER,DFN,HL) ;
8 N RGRSDFN,OTHSITE,NODE,ICN,CMORIEN,CMOR,CMORDISP,SENSTVTY,RMTDOD,LOCDOD,VAFCA,VAFCA08,HERE,BOGUS,ARAY,REP
9 S REP=$E(HL("ECH"),2)
10 S HERE=$P($$SITE^VASITE,"^",3)
11 ;if sending site is your site quit
12 Q:$G(ARRAY("MPISSITE"))=$G(HERE)
13 S ARRAY(.097)=$P($$NOW^XLFDT,".")
14 I $G(ARRAY("ICN"))'="" D
15 .S RGRSDFN=$$GETDFN^MPIF001(+ARRAY("ICN")) I +RGRSDFN<1 S RGER=RGRSDFN_" ICN#"_$G(ARRAY("ICN")) Q ;quit and return error msg
16 .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
17 I $G(RGRSDFN)="" S RGRSDFN=$G(DFN)
18 I $G(RGRSDFN)="" S RGER="-1^DFN not defined"
19 Q:$G(RGER)
20 I $G(OTHSITE)="" S OTHSITE=""
21 S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
22 S ICN=$P(NODE,"^")
23 S CMORIEN=$P(NODE,"^",3)
24 S CMOR=$$NS^XUAF4(CMORIEN)
25 S CMORDISP=$P(CMOR,"^",1)
26 S CMOR=$P(CMOR,"^",2)
27 ;
28 ;If patient is Sensitive at other site but not here send bulletin
29 I $G(ARRAY("SENSITIVITY"))'="" S SENSTVTY=$G(ARRAY("SENSITIVITY")) D
30 .N NAME S NAME=ARRAY("NAME")
31 .I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D
32 ..S ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
33 ..S ARAY("SENSITIVITY USER")=ARRAY("SENSITIVITY USER"),ARAY("SENSITIVITY DATE")=ARRAY("SENSITIVITY DATE")
34 ..D SENSTIVE^RGRSBUL1(RGRSDFN,"ARAY",NAME)
35 ;
36 ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
37 ;Ignore time if present with date.
38 S RMTDOD=$G(ARRAY("MPIDOD")),RMTDOD=$P(RMTDOD,".")
39 S DFN=RGRSDFN D DEM^VADPT
40 S LOCDOD=$P($P(VADM(6),"^"),".")
41 ;If there is a remote DOD but no local DOD OR if remote DOD is different from local DOD, send bulletin
42 I RMTDOD D
43 .N NAME S NAME=ARRAY("NAME"),ARAY("SSN")=ARRAY("SSN"),ARAY("SENDING SITE")=ARRAY("SENDING SITE")
44 .D RMTDOD^RGRSBUL1(RGRSDFN,"ARAY",NAME,RMTDOD,LOCDOD)
45 K VADM
46 ;
47NOTLOC I 'RGLOCAL D
48 .;if sending site is not the CMOR AND NOT THE MPI - log update into PDR if differences exist **45 ADDED MPI
49 .I (OTHSITE)'=(CMOR)&(OTHSITE'="200M") D Q
50 ..S VAFCA=$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"^"_$G(ARRAY("SENDING SITE"))_"^"_RGRSDFN
51 ..S ARRAY(.01)=$$FREE^RGRSPARS(ARRAY("NAME")),ARRAY(.03)=$$FREE^RGRSPARS($G(ARRAY("MPIDOB")))
52 ..S ARRAY(.09)=$$FREE^RGRSPARS($G(ARRAY("SSN"))),ARRAY(.02)=$$SEX^RGRSPARS($G(ARRAY("SEX")))
53 ..S ARRAY(.2403)=$$FREE^RGRSPARS($G(ARRAY("MMN"))),ARRAY(991.01)=$P($G(ARRAY("ICN")),"V")
54 ..N ARAY M ARAY(2)=ARRAY
55 ..S VAFCA08=1 ;S BOGUS=$$ADD^VAFCEHU1(VAFCA,"ARAY") comment out by RG*1*49
56 .;if sending site is the CMOR OR MPI - synchronize data **45 ADDED MPI AND SSNV TO UPDATED FIELDS
57 .I (OTHSITE)=(CMOR)!(OTHSITE="200M") D
58 ..;**44 is there an outstanding edit in the ADT/HL7 PIVOT file for this patient for an identity element
59 ..S RGER=$$CHKPVT^RGADTP3(.ARRAY) Q:+RGER<0
60 ..N DR,ARAY2 S RGER=""
61 ..D DIFF^RGADTP3(.ARRAY,RGRSDFN,.DR,.ARRAY) ;**47
62 ..I DR'="" D
63 ...S VAFCA08=1,ARAY(2,.01)=ARRAY("NAME"),ARAY(2,.03)=$G(ARRAY("MPIDOB"))
64 ...I ARRAY("SSN")'="" S ARAY(2,.09)=$G(ARRAY("SSN")) ;**45 only set SSN to update if it isn't null
65 ...S ARAY(2,.02)=$G(ARRAY("SEX")),ARAY(2,.2403)=$G(ARRAY("MMN")),ARAY(2,994)=$G(ARRAY("MBI"))
66 ...;**48 ONLY SET SSN VERIFICATION STATUS AND PSEUDO SSN REASON IF SSN UPDATE WAS SUCCESSFUL
67 ...I $D(ARRAY("ALIAS")) M ARAY(2,1)=ARRAY("ALIAS") ;**48 ADD ALIAS TO MIX
68 ...D EDIT^VAFCPTED(RGRSDFN,"ARAY(2)",DR)
69 ...;check to see if edits were successful, if not set RGER="why it failed"
70 ...N NAME,SSN,PDOB,SEX,MMN,OLDNAME,OLDHLNAM,OLDMMN,OLDHLMMN,HLNAME,HLMMN,SSNV,MBI
71 ...S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01,"I"),PDOB=$$GET1^DIQ(2,+RGRSDFN_",",.03,"I")
72 ...S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09,"I"),SEX=$$GET1^DIQ(2,+RGRSDFN_",",.02,"I")
73 ...S MMN=$$GET1^DIQ(2,+RGRSDFN_",",.2403,"I"),MBI=$$GET1^DIQ(2,+RGRSDFN_",",994,"I")
74 ...D STDNAME^XLFNAME(.NAME,"F",.OLDNAME) S HLNAME=ARRAY("NAME") D STDNAME^XLFNAME(.HLNAME,"F",.OLDHLNAM)
75 ...I NAME'=$G(HLNAME) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Name field failure"
76 ...I PDOB'=$G(ARRAY("MPIDOB")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"DOB field failure"
77 ...;**48
78 ...I SSN["P" D
79 ....;if pseudo SSN reason field has been added to the DD then attempt to set it
80 ....N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
81 .....S ARAY2(2,.0906)=$G(ARRAY(.0906)),DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
82 .....S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
83 .....I PS=""&(ARAY2(2,.0906)="@") Q
84 .....I PS'=ARAY2(2,.0906) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
85 .....I PS=ARAY2(2,.0906) D
86 ......K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
87 ......S ARAY2(2,.0907)=$G(ARRAY(.0907)),DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
88 ......S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
89 ......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"
90 ...I $G(ARRAY("SSN"))'="",SSN'=$G(ARRAY("SSN")) D
91 ....I $G(ARRAY("SSN"))="P",SSN["P" Q ;**47 NEEDED TO CREATE PSEUDO AND DID
92 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SSN field failure" ;**45 only check if SSN is sent isn't null
93 ...I SSN=$G(ARRAY("SSN")) D
94 ....;if SSN VERIFICATION STATUS field has been added to the DD then attempt to set it
95 ....K ARAY2 N ERROR,LABEL D FIELD^DID(2,.0907,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
96 .....S ARAY2(2,.0907)=$G(ARRAY(.0907)) S DR=".0907;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
97 .....S SSNV=$$GET1^DIQ(2,+RGRSDFN_",",.0907,"I")
98 .....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"
99 .....I SSNV'="" D
100 ......N PS,ERROR,LABEL D FIELD^DID(2,.0906,"","LABEL","LABEL","ERROR") I '$D(ERROR("DIERR"))&$D(LABEL("LABEL")) D
101 ......S ARAY2(2,.0906)=$G(ARRAY(.0906)) S DR=".0906;" D EDIT^VAFCPTED(RGRSDFN,"ARAY2(2)",DR)
102 ......S PS=$$GET1^DIQ(2,+RGRSDFN_",",.0906,"I")
103 ......I PS=""&(ARAY2(2,.0906)="@") Q
104 ......S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"Pseudo SSN Reason field failure"
105 ...I SEX'=$G(ARRAY("SEX")) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"SEX field failure"
106 ...D STDNAME^XLFNAME(.MMN,"F",.OLDMMN) S HLMMN=ARRAY("MMN") D STDNAME^XLFNAME(.HLMMN,"F",.OLDHLMMN)
107 ...I MMN'=$G(HLMMN) S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MOTHER'S MAIDEN NAME field failure"
108 ...;**REMOVED MBI FROM PATCH 45 PUT BACK IN **47
109 ...I MBI'=$G(ARRAY("MBI")) D
110 ....Q:MBI=""&($G(ARRAY("MBI"))="@") ;**47 "" AND @ ARE THE SAME
111 ....S RGER=$S($G(RGER)'="":$G(RGER)_REP,1:"-1^")_"MULTIPLE BIRTH INDICATOR field failure"
112 ...;send the updated fields to the MPI to synch site with MPI
113 ...I HL("ETN")'="A31" S ZTSAVE("DFN")="",ZTRTN="MPISYN^RGADTPC",ZTDESC="Sending Synchronized Patient Data to MPI...",ZTIO="RG QUEUE",ZTDTH=$H D ^%ZTLOAD
114 ...;**45 ^ don't trigger A31 sync message if A31 was being processed-- ack to a31 will sync id elements on MPI
115 Q
Note: See TracBrowser for help on using the repository browser.