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

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1RGRSPT ;ALB/RJS,CML-HIGH LEVEL ROUTINE FOR PARSING AND FILING ;06/25/98
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,7,8**;30 Apr 99
3 ;
4 ;Parse Incoming Message, and file.
5 ;
6 ;
7 Q:($G(HL("MTN"))'="ADT")
8 N RGRSDFN,VAFCA,RGRS,VAFCA08,RGRSARAY,BOGUS,RGDC,SENSTVTY,CMORDISP
9 N NAME,LASTNAME,SSN,ICN,CMOR,CMORIEN,OTHSITE,RGRSDATA,HERE,BULSUB,NODE
10 S RGRSARAY="RGRS(2)"
11 D INITIZE^RGRSUTIL ;copy HL7 message into local RGDC array
12 S VAFCA=$$EN^RGRSMSH() ;parse MSH for filer
13 D EN^RGRSPARS(RGRSARAY) ;parse HL7 message into local array RGRS
14 I $$SKIP^RGRSZZPT(1,RGRSARAY) D G EXIT ;skip if certain data is not there
15 . D SKIPBULL^RGRSBULL(RGRSARAY)
16 S RGRSDFN=$$GETDFN^MPIF001(@RGRSARAY@(991.01)) ;Get DFN from ICN
17 Q:+$$SEND2^VAFCUTL1(RGRSDFN,"T") ;safeguard to prevent the processing of test patients
18 S OTHSITE=@RGRSARAY@("SITENUM")\1
19 S HERE=$P($$SITE^VASITE,"^",3)\1
20 ;
21 ;If patient not known in site, send bulletin, go exit
22 ;
23 I +RGRSDFN=-1 D EXC^RGHLLOG(210,"Msg#"_$G(HL("MID"))_" Bad DFN#"_$G(RGRSDFN)_" for "_$G(@RGRSARAY@(.01))_" (ICN#"_$G(@RGRSARAY@(991.01))_")") D STOP^RGHLLOG(1) Q
24 ;
25 S NAME=$$GET1^DIQ(2,+RGRSDFN_",",.01)
26 S LASTNAME=$P(NAME,",",1)
27 S SSN=$$GET1^DIQ(2,+RGRSDFN_",",.09)
28 S NODE=$$MPINODE^MPIFAPI(RGRSDFN)
29 S ICN=$P(NODE,"^")
30 S CMORIEN=$P(NODE,"^",3)
31 S CMOR=$$NS^XUAF4(CMORIEN)
32 S CMORDISP=$P(CMOR,"^",1)
33 S CMOR=$P(CMOR,"^",2)
34 ;
35 S @RGRSARAY@("NAME")=@RGRSARAY@(.01)
36 S @RGRSARAY@("SSN")=@RGRSARAY@(.09)
37 S @RGRSARAY@("ICN")=@RGRSARAY@(991.01)
38 S @RGRSARAY@("CMOR")=$P($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
39 ;
40 ;If ICN or CMOR don't match, send bulletin and go exit
41 I '$$MATCH(RGRSDFN,RGRSARAY,,,ICN,CMOR,.BULSUB) D G EXIT
42 . D MTCHBULL^RGRSBULL(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP,BULSUB)
43 ;
44 ;if ICN and CMOR match, check for SSN edit from CMOR
45 I @RGRSARAY@("SENDING SITE")=CMOR,(SSN'=@RGRSARAY@(.09)) D
46 .D SSNBULL^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,SSN,ICN,CMORDISP)
47 ;
48 ;If patient is Sensitive at other site but not here send bulletin
49 S SENSTVTY=$G(@RGRSARAY@("SENSITIVITY"))
50 I '$$SENSTIVE^RGRSENS(RGRSDFN),SENSTVTY D SENSTIVE^RGRSBUL1(RGRSDFN,RGRSARAY,NAME)
51 ;
52 ;If patient has DATE OF DEATH (DOD) at remote site send bulletin
53 ;Ignore time if present with date.
54 S RMTDOD=@RGRSARAY@(.351),RMTDOD=$P(RMTDOD,".")
55 S DFN=RGRSDFN D DEM^VADPT
56 S LOCDOD=$P($P(VADM(6),"^"),".")
57 ;If there is a remote DOD but no local DOD OR
58 ;if remote DOD is different from local DOD, send bulletin
59 I RMTDOD D RMTDOD^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,RMTDOD,LOCDOD)
60 K LOCDOD,RMTDOD,VADM
61 ;
62 D G EXIT ;**7
63 . ;
64 . ;IF it's the CMOR - review file
65 . ;
66 . I (OTHSITE)=(HERE) D Q
67 . . S VAFCA=VAFCA_"^"_RGRSDFN
68 . . S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"RGRS")
69 . ;
70 . ;IF it's not the CMOR - Don't Rebroadcast
71 . ;
72 . I (OTHSITE)'=(HERE) D Q
73 . . S VAFCA08=1
74 . . D EDIT^VAFCPTED(RGRSDFN,RGRSARAY,".01;.03;.09;.02;.2403") ;**7 broadcasted fields - removed .05,.08,.111;.112;.113;.114;.115;.1112;.117;.131;.132;.211;.219;.31115
75EXIT ;
76 Q
77 ;
78MATCH(DFN,RGRSARAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ;
79 Q:$G(DFN)=""!($G(RGRSARAY)="") 0
80 N COUNT,TRUE S (COUNT,TRUE)=0
81 S BULSUB=""
82 I $D(LASTNAME) D
83 . S COUNT=COUNT+1
84 . I (LASTNAME'=""),(LASTNAME=$P(@RGRSARAY@(.01),",",1)) S TRUE=TRUE+1
85 I $D(SSN) D
86 . S COUNT=COUNT+1
87 . I (SSN'=""),(SSN=$G(@RGRSARAY@(.09))) S TRUE=TRUE+1
88 I $D(ICN) D
89 . S COUNT=COUNT+1
90 . I (ICN'=""),(ICN=$G(@RGRSARAY@(991.01))) S TRUE=TRUE+1 Q
91 . S BULSUB=BULSUB_"ICN"
92 I $D(CMOR) D
93 . S COUNT=COUNT+1
94 . I (CMOR'=""),(CMOR=$G(@RGRSARAY@("SITENUM"))) S TRUE=TRUE+1 Q
95 . I BULSUB]"" S BULSUB=BULSUB_" & "
96 . S BULSUB=BULSUB_"CMOR"
97 I COUNT=TRUE Q 1
98 Q 0
Note: See TracBrowser for help on using the repository browser.