RGRSENS ;ALB/RJS,CML-PT SENSITIVITY PARSER/FILER ;06/25/98
;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
;
;Parse Incoming Message, and file.
;
;
N RGRSDFN,VAFCA,RGRS,VAFCA08,ARRAY,BOGUS,RGDC,RGRSDATA
N NAME,LASTNAME,SSN,ICN,CMOR,OTHSITE,SENSTVTY,CMORIEN,CMORDISP,BULSUB
S ARRAY="RGRS(2)"
D INITIZE^RGRSUTIL ;copy HL7 message into local RGDC array
D EN^RGRSPAR2(ARRAY) ;parse HL7 nessage into local array RGRS
I $$SKIP^RGRSZZPT(1,ARRAY) D G EXIT ;skip if certain data is not there
. D SKIPBULL^RGRSBULL(ARRAY)
S RGRSDFN=$$GETDFN^MPIF001(@ARRAY@(991.01)) ;Get DFN from ICN
S OTHSITE=@ARRAY@("SENDING SITE")
;
;If patient not known in site, send bulletin, go exit
;
I +RGRSDFN=-1 M RGRS("MESSAGE")=RGDC D NOT2^RGRSBUL1(ARRAY) G EXIT
;
D GETDATA^MPIFQ0("^DPT(",RGRSDFN,"RGRSDATA",".01;.09;991.01;991.03","EI")
S NAME=$G(RGRSDATA(2,RGRSDFN,.01,"E"))
S LASTNAME=$P(NAME,",",1)
S SSN=$G(RGRSDATA(2,RGRSDFN,.09,"E"))
S ICN=$G(RGRSDATA(2,RGRSDFN,991.01,"E"))
S CMORIEN=$G(RGRSDATA(2,RGRSDFN,991.03,"I"))
S CMOR=$$NS^XUAF4(CMORIEN)
S CMORDISP=$P(CMOR,"^",1)
S CMOR=$P(CMOR,"^",2)
;
S @ARRAY@("NAME")=@ARRAY@(.01)
S @ARRAY@("SSN")=@ARRAY@(.09)
S @ARRAY@("ICN")=@ARRAY@(991.01)
S @ARRAY@("CMOR")=$P($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
;
;If ICN or CMOR don't match, send bulletin and go exit
I '$$MATCH(RGRSDFN,ARRAY,,,ICN,CMOR,.BULSUB) D G EXIT
. D MTCHBULL^RGRSBULL(RGRSDFN,ARRAY,NAME,SSN,ICN,CMORDISP,BULSUB)
;
;If patient is Sensitive at other site but not here send bulletin
S SENSTVTY=@ARRAY@("SENSITIVITY")
I '$$SENSTIVE(RGRSDFN),SENSTVTY D SENSTIVE^RGRSBUL1(RGRSDFN,ARRAY,NAME)
;
EXIT ;
Q
;
SENSTIVE(DFN) ;CHECK SENSITIVITY FLAG FOR A PATIENT
Q:$G(DFN)="" 0
Q:$P($G(^DGSL(38.1,DFN,0)),"^",2)=1 1
Q 0
;
;
MATCH(DFN,ARRAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ;
Q:$G(DFN)=""!($G(ARRAY)="") 0
N COUNT,TRUE S (COUNT,TRUE)=0
S BULSUB=""
I $D(LASTNAME) D
. S COUNT=COUNT+1
. I (LASTNAME'=""),(LASTNAME=$P(@ARRAY@(.01),",",1)) S TRUE=TRUE+1
I $D(SSN) D
. S COUNT=COUNT+1
. I (SSN'=""),(SSN=$G(@ARRAY@(.09))) S TRUE=TRUE+1
I $D(ICN) D
. S COUNT=COUNT+1
. I (ICN'=""),(ICN=$G(@ARRAY@(991.01))) S TRUE=TRUE+1 Q
. S BULSUB=BULSUB_"ICN"
I $D(CMOR) D
. S COUNT=COUNT+1
. I (CMOR'=""),(CMOR=$G(@ARRAY@("SITENUM"))) S TRUE=TRUE+1 Q
. I BULSUB]"" S BULSUB=BULSUB_" & "
. S BULSUB=BULSUB_"CMOR"
I COUNT=TRUE Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSENS 2439 printed Apr 09, 2024@20:48:01 Page 2
RGRSENS ;ALB/RJS,CML-PT SENSITIVITY PARSER/FILER ;06/25/98
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
+2 ;
+3 ;Parse Incoming Message, and file.
+4 ;
+5 ;
+6 NEW RGRSDFN,VAFCA,RGRS,VAFCA08,ARRAY,BOGUS,RGDC,RGRSDATA
+7 NEW NAME,LASTNAME,SSN,ICN,CMOR,OTHSITE,SENSTVTY,CMORIEN,CMORDISP,BULSUB
+8 SET ARRAY="RGRS(2)"
+9 ;copy HL7 message into local RGDC array
DO INITIZE^RGRSUTIL
+10 ;parse HL7 nessage into local array RGRS
DO EN^RGRSPAR2(ARRAY)
+11 ;skip if certain data is not there
IF $$SKIP^RGRSZZPT(1,ARRAY)
Begin DoDot:1
+12 DO SKIPBULL^RGRSBULL(ARRAY)
End DoDot:1
GOTO EXIT
+13 ;Get DFN from ICN
SET RGRSDFN=$$GETDFN^MPIF001(@ARRAY@(991.01))
+14 SET OTHSITE=@ARRAY@("SENDING SITE")
+15 ;
+16 ;If patient not known in site, send bulletin, go exit
+17 ;
+18 IF +RGRSDFN=-1
MERGE RGRS("MESSAGE")=RGDC
DO NOT2^RGRSBUL1(ARRAY)
GOTO EXIT
+19 ;
+20 DO GETDATA^MPIFQ0("^DPT(",RGRSDFN,"RGRSDATA",".01;.09;991.01;991.03","EI")
+21 SET NAME=$GET(RGRSDATA(2,RGRSDFN,.01,"E"))
+22 SET LASTNAME=$PIECE(NAME,",",1)
+23 SET SSN=$GET(RGRSDATA(2,RGRSDFN,.09,"E"))
+24 SET ICN=$GET(RGRSDATA(2,RGRSDFN,991.01,"E"))
+25 SET CMORIEN=$GET(RGRSDATA(2,RGRSDFN,991.03,"I"))
+26 SET CMOR=$$NS^XUAF4(CMORIEN)
+27 SET CMORDISP=$PIECE(CMOR,"^",1)
+28 SET CMOR=$PIECE(CMOR,"^",2)
+29 ;
+30 SET @ARRAY@("NAME")=@ARRAY@(.01)
+31 SET @ARRAY@("SSN")=@ARRAY@(.09)
+32 SET @ARRAY@("ICN")=@ARRAY@(991.01)
+33 SET @ARRAY@("CMOR")=$PIECE($$NS^XUAF4($$LKUP^XUAF4(OTHSITE)),"^")
+34 ;
+35 ;If ICN or CMOR don't match, send bulletin and go exit
+36 IF '$$MATCH(RGRSDFN,ARRAY,,,ICN,CMOR,.BULSUB)
Begin DoDot:1
+37 DO MTCHBULL^RGRSBULL(RGRSDFN,ARRAY,NAME,SSN,ICN,CMORDISP,BULSUB)
End DoDot:1
GOTO EXIT
+38 ;
+39 ;If patient is Sensitive at other site but not here send bulletin
+40 SET SENSTVTY=@ARRAY@("SENSITIVITY")
+41 IF '$$SENSTIVE(RGRSDFN)
IF SENSTVTY
DO SENSTIVE^RGRSBUL1(RGRSDFN,ARRAY,NAME)
+42 ;
EXIT ;
+1 QUIT
+2 ;
SENSTIVE(DFN) ;CHECK SENSITIVITY FLAG FOR A PATIENT
+1 if $GET(DFN)=""
QUIT 0
+2 if $PIECE($GET(^DGSL(38.1,DFN,0)),"^",2)=1
QUIT 1
+3 QUIT 0
+4 ;
+5 ;
MATCH(DFN,ARRAY,LASTNAME,SSN,ICN,CMOR,BULSUB) ;
+1 if $GET(DFN)=""!($GET(ARRAY)="")
QUIT 0
+2 NEW COUNT,TRUE
SET (COUNT,TRUE)=0
+3 SET BULSUB=""
+4 IF $DATA(LASTNAME)
Begin DoDot:1
+5 SET COUNT=COUNT+1
+6 IF (LASTNAME'="")
IF (LASTNAME=$PIECE(@ARRAY@(.01),",",1))
SET TRUE=TRUE+1
End DoDot:1
+7 IF $DATA(SSN)
Begin DoDot:1
+8 SET COUNT=COUNT+1
+9 IF (SSN'="")
IF (SSN=$GET(@ARRAY@(.09)))
SET TRUE=TRUE+1
End DoDot:1
+10 IF $DATA(ICN)
Begin DoDot:1
+11 SET COUNT=COUNT+1
+12 IF (ICN'="")
IF (ICN=$GET(@ARRAY@(991.01)))
SET TRUE=TRUE+1
QUIT
+13 SET BULSUB=BULSUB_"ICN"
End DoDot:1
+14 IF $DATA(CMOR)
Begin DoDot:1
+15 SET COUNT=COUNT+1
+16 IF (CMOR'="")
IF (CMOR=$GET(@ARRAY@("SITENUM")))
SET TRUE=TRUE+1
QUIT
+17 IF BULSUB]""
SET BULSUB=BULSUB_" & "
+18 SET BULSUB=BULSUB_"CMOR"
End DoDot:1
+19 IF COUNT=TRUE
QUIT 1
+20 QUIT 0
