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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1RGRSENS ;ALB/RJS,CML-PT SENSITIVITY PARSER/FILER ;06/25/98
2 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
3 ;
4 ;Parse Incoming Message, and file.
5 ;
6 ;
7 N RGRSDFN,VAFCA,RGRS,VAFCA08,ARRAY,BOGUS,RGDC,RGRSDATA
8 N NAME,LASTNAME,SSN,ICN,CMOR,OTHSITE,SENSTVTY,CMORIEN,CMORDISP,BULSUB
9 S ARRAY="RGRS(2)"
10 D INITIZE^RGRSUTIL ;copy HL7 message into local RGDC array
11 D EN^RGRSPAR2(ARRAY) ;parse HL7 nessage into local array RGRS
12 I $$SKIP^RGRSZZPT(1,ARRAY) D G EXIT ;skip if certain data is not there
13 . D SKIPBULL^RGRSBULL(ARRAY)
14 S RGRSDFN=$$GETDFN^MPIF001(@ARRAY@(991.01)) ;Get DFN from ICN
15 S OTHSITE=@ARRAY@("SENDING SITE")
16 ;
17 ;If patient not known in site, send bulletin, go exit
18 ;
19 I +RGRSDFN=-1 M RGRS("MESSAGE")=RGDC D NOT2^RGRSBUL1(ARRAY) G EXIT
20 ;
21 D GETDATA^MPIFQ0("^DPT(",RGRSDFN,"RGRSDATA",".01;.09;991.01;991.03","EI")
22 S NAME=$G(RGRSDATA(2,RGRSDFN,.01,"E"))
23 S LASTNAME=$P(NAME,",",1)
24 S SSN=$G(RGRSDATA(2,RGRSDFN,.09,"E"))
25 S ICN=$G(RGRSDATA(2,RGRSDFN,991.01,"E"))
26 S CMORIEN=$G(RGRSDATA(2,RGRSDFN,991.03,"I"))
27 S CMOR=$$NS^XUAF4(CMORIEN)
28 S CMORDISP=$P(CMOR,"^",1)
29 S CMOR=$P(CMOR,"^",2)
30 ;
31 S @ARRAY@("NAME")=@ARRAY@(.01)
32 S @ARRAY@("SSN")=@ARRAY@(.09)
33 S @ARRAY@("ICN")=@ARRAY@(991.01)
34 S @ARRAY@("CMOR")=$P($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
35 ;
36 ;If ICN or CMOR don't match, send bulletin and go exit
37 I '$$MATCH(RGRSDFN,ARRAY,,,ICN,CMOR,.BULSUB) D G EXIT
38 . D MTCHBULL^RGRSBULL(RGRSDFN,ARRAY,NAME,SSN,ICN,CMORDISP,BULSUB)
39 ;
40 ;If patient is Sensitive at other site but not here send bulletin
41 S SENSTVTY=@ARRAY@("SENSITIVITY")
42 I '$$SENSTIVE(RGRSDFN),SENSTVTY D SENSTIVE^RGRSBUL1(RGRSDFN,ARRAY,NAME)
43 ;
44EXIT ;
45 Q
46 ;
47SENSTIVE(DFN) ;CHECK SENSITIVITY FLAG FOR A PATIENT
48 Q:$G(DFN)="" 0
49 Q:$P($G(^DGSL(38.1,DFN,0)),"^",2)=1 1
50 Q 0
51 ;
52 ;
53MATCH(DFN,ARRAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ;
54 Q:$G(DFN)=""!($G(ARRAY)="") 0
55 N COUNT,TRUE S (COUNT,TRUE)=0
56 S BULSUB=""
57 I $D(LASTNAME) D
58 . S COUNT=COUNT+1
59 . I (LASTNAME'=""),(LASTNAME=$P(@ARRAY@(.01),",",1)) S TRUE=TRUE+1
60 I $D(SSN) D
61 . S COUNT=COUNT+1
62 . I (SSN'=""),(SSN=$G(@ARRAY@(.09))) S TRUE=TRUE+1
63 I $D(ICN) D
64 . S COUNT=COUNT+1
65 . I (ICN'=""),(ICN=$G(@ARRAY@(991.01))) S TRUE=TRUE+1 Q
66 . S BULSUB=BULSUB_"ICN"
67 I $D(CMOR) D
68 . S COUNT=COUNT+1
69 . I (CMOR'=""),(CMOR=$G(@ARRAY@("SITENUM"))) S TRUE=TRUE+1 Q
70 . I BULSUB]"" S BULSUB=BULSUB_" & "
71 . S BULSUB=BULSUB_"CMOR"
72 I COUNT=TRUE Q 1
73 Q 0
Note: See TracBrowser for help on using the repository browser.