- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSPT.m
r613 r623 1 RGRSPT ;ALB/RJS,CML-HIGH LEVEL ROUTINE FOR PARSING AND FILING ;06/25/98 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**1,3,7,8,52**;30 Apr 99;Build 2 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 ;MPIC_772 - **52; Commented out Remote Date of Death Indicated section. 53 ;If patient has DATE OF DEATH (DOD) at remote site send bulletin 54 ;Ignore time if present with date. 55 ;S RMTDOD=@RGRSARAY@(.351),RMTDOD=$P(RMTDOD,".") 56 ;S DFN=RGRSDFN D DEM^VADPT 57 ;S LOCDOD=$P($P(VADM(6),"^"),".") 58 ;If there is a remote DOD but no local DOD OR 59 ;if remote DOD is different from local DOD, send bulletin 60 ;I RMTDOD D RMTDOD^RGRSBUL1(RGRSDFN,RGRSARAY,NAME,RMTDOD,LOCDOD) 61 ;K LOCDOD,RMTDOD,VADM 62 ; 63 D G EXIT ;**7 64 . ; 65 . ;IF it's the CMOR - review file 66 . ; 67 . I (OTHSITE)=(HERE) D Q 68 . . S VAFCA=VAFCA_"^"_RGRSDFN 69 . . S VAFCA08=1 S BOGUS=$$ADD^VAFCEHU1(VAFCA,"RGRS") 70 . ; 71 . ;IF it's not the CMOR - Don't Rebroadcast 72 . ; 73 . I (OTHSITE)'=(HERE) D Q 74 . . S VAFCA08=1 75 . . 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 76 EXIT ; 77 Q 78 ; 79 MATCH(DFN,RGRSARAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ; 80 Q:$G(DFN)=""!($G(RGRSARAY)="") 0 81 N COUNT,TRUE S (COUNT,TRUE)=0 82 S BULSUB="" 83 I $D(LASTNAME) D 84 . S COUNT=COUNT+1 85 . I (LASTNAME'=""),(LASTNAME=$P(@RGRSARAY@(.01),",",1)) S TRUE=TRUE+1 86 I $D(SSN) D 87 . S COUNT=COUNT+1 88 . I (SSN'=""),(SSN=$G(@RGRSARAY@(.09))) S TRUE=TRUE+1 89 I $D(ICN) D 90 . S COUNT=COUNT+1 91 . I (ICN'=""),(ICN=$G(@RGRSARAY@(991.01))) S TRUE=TRUE+1 Q 92 . S BULSUB=BULSUB_"ICN" 93 I $D(CMOR) D 94 . S COUNT=COUNT+1 95 . I (CMOR'=""),(CMOR=$G(@RGRSARAY@("SITENUM"))) S TRUE=TRUE+1 Q 96 . I BULSUB]"" S BULSUB=BULSUB_" & " 97 . S BULSUB=BULSUB_"CMOR" 98 I COUNT=TRUE Q 1 99 Q 0 1 RGRSPT ;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 75 EXIT ; 76 Q 77 ; 78 MATCH(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 TracChangeset
for help on using the changeset viewer.
