TIUHL7P1 ; SLC/AJB - TIUHL7 Msg Processing; January 6, 2006
;;1.0;TEXT INTEGRATION UTILITIES;**200,228**;Jun 20, 1997
Q
PROCMSG ;
N DFN,DUZ,TIU,TIUDA,TIUDPRM,TIUDT,TIUERR,TIUI,TIUJ,TIUMSG,TIUNAME,TIUTMP,TIUFS,TIUCS,TIURS,TIUES,TIUSS,TIUZ
;
; quit if HL7 Message IEN is not present
;I '+$G(HLMTIENS) Q
;
; remove HL7 message entries 7 days or older
D CLEAN^TIUHL7U1
;
; sets field, component and repetition separators from HL7 Message
S TIUFS=$G(HL("FS")),TIUJ=0 F TIUI="TIUCS","TIURS","TIUES","TIUSS" S TIUJ=TIUJ+1 S @TIUI=$E(HL("ECH"),TIUJ,TIUJ)
;
; initializes variables and ^XTMP expiration
S TIU="TIU",(TIU("EC"),TIUDA)=0,TIUDT=+$$NOW^XLFDT,TIUNAME=$NA(^XTMP("TIUHL7",TIUDT,HLMTIENS)),^XTMP("TIUHL7",0)=$$FMADD^XLFDT(TIUDT,7)_U_TIUDT
;
; retrieves HL7 message and stores to temporary global
F TIUI=1:1 X HLNEXT Q:HLQUIT'>0 D
. S @TIUNAME@("MSG",TIUI)=HLNODE,TIUJ=0
. F S TIUJ=$O(HLNODE(TIUJ)) Q:'TIUJ S @TIUNAME@("MSG",TIUI)=@TIUNAME@("MSG",TIUI)_HLNODE(TIUJ)
;
; places temporary global in local meory & adds EOM flag
M TIUMSG=@TIUNAME@("MSG")
S TIU("XTMP")=TIUNAME,TIUNAME="TIUMSG",TIUI="",TIUI=$O(TIUMSG(TIUI),-1),TIUI=TIUI+1,TIUMSG(TIUI)="EOM"
;
; verify message format
S TIUI="" F S TIUI=$O(@TIUNAME@(TIUI)) Q:@TIUNAME@(TIUI)="EOM" D
. S TIUJ=$S(TIUI=1:"MSH",TIUI=2:"EVN",TIUI=3:"PID",TIUI=4:"PV1",TIUI=5:"TXA",TIUI=6:"OBX",1:"OBX")
. I $P(@TIUNAME@(TIUI),TIUFS)'=TIUJ D ERR^TIUHL7U1("MSG",1,"000.000","Improper/missing message format: "_TIUJ_" segment.")
;
; if message fails check, quit processing
I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
;
; get patient name [required]
S TIU("PTNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($P($P($G(@TIUNAME@(3)),TIUFS,6),TIUCS,1,4),TIUCS)),TIU("PTNAME")=$$REMESC^TIUHL7U1(TIU("PTNAME"))
;
; get patient ICN/SSN/DFN - order may vary [conditionally required]
S (TIU("DFN"),TIU("ICN"),TIU("SSN"))="" F TIUI=1:1:$L($P($G(@TIUNAME@(3)),TIUFS,4),TIURS) S TIUJ=$P($P($G(@TIUNAME@(3)),TIUFS,4),TIURS,TIUI) I +TIUJ>0 D
. S TIUTMP=$S($P(TIUJ,TIUCS,5)="NI":"ICN",$P(TIUJ,TIUCS,5)="SS":"SSN",$P(TIUJ,TIUCS,5)="PI":"DFN",1:"UNK")
. S @TIU@(TIUTMP)=$$REMESC^TIUHL7U1($P(TIUJ,TIUCS)) I TIUTMP="ICN",@TIU@(TIUTMP)["V" S @TIU@(TIUTMP)=$P(@TIU@(TIUTMP),"V")
;
; get PATIENT DOB (optional)
S TIU("DOB")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($P($G(@TIUNAME@(3)),TIUFS,8)))
;
; get DOCUMENT TITLE (#8925.1) [required] & set IEN
S TIU("TITLE")=$$UPPER^HLFNC($P($G(@TIUNAME@(5)),TIUFS,17)),TIU("TITLE")=$$REMESC^TIUHL7U1(TIU("TITLE"))
S TIU("TDA")=$$LU^TIUHL7U1(8925.1,TIU("TITLE"),"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""") I $L(TIU("TITLE"))'>0 S TIU("TITLE")="[UNKNOWN]"
;
; get DOCUMENT AVAILABILITY [optional]
S TIU("AVAIL")=$$REMESC^TIUHL7U1($P($G(@TIUNAME@(5)),TIUFS,20))
;
;gets DOCUMENT COMPLETION STATUS [optional]
S TIU("COMP")=$$REMESC^TIUHL7U1($P($G(@TIUNAME@(5)),TIUFS,18))
;
; get REFERENCE DATE [required]
S TIU("RFDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($P($G(@TIUNAME@(5)),TIUFS,5))) I TIU("RFDT")'>-1 D ERR^TIUHL7U1("TXA",4,"0000.00","Invalid HL7 date format for ACTIVITY DATE/TIME[REFERENCE DATE/TIME].")
I +$P(TIU("RFDT"),"."),'+$P(TIU("RFDT"),".",2) S $P(TIU("RFDT"),".",2)=$P($$NOW^XLFDT,".",2)
;
; get EPISODE BEGIN DT/TIME [conditionally required for DISCHARGE SUMMARIES]
S TIU("EPDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($P($G(@TIUNAME@(4)),TIUFS,45))) I TIU("EPDT")'>-1 D ERR^TIUHL7U1("PV1",44,"0000.00","Invalid HL7 date format for ADMIT DATE/TIME [EPISODE BEGIN DATE/TIME].")
I +$P(TIU("EPDT"),"."),'+$P(TIU("EPDT"),".",2) S $P(TIU("EPDT"),".",2)=$P($$NOW^XLFDT,".",2)
;
; get DICTATION DT/TIME [optional]
S TIU("DICDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($P($G(@TIUNAME@(5)),TIUFS,7))) I TIU("DICDT")'>-1 D ERR^TIUHL7U1("TXA",6,"0000.00","Invalid HL7 date format for TRANSCRIPTION DATE/TIME[DICTATION DATE/TIME].")
I +$P(TIU("DICDT"),"."),'+$P(TIU("DICDT"),".",2) S $P(TIU("DICDT"),".",2)=$P($$NOW^XLFDT,".",2)
;
; get VISIT # [optional]
S TIU("VNUM")=$$REMESC^TIUHL7U1($P($G(@TIUNAME@(4)),TIUFS,20))
;
; get HOSPITAL LOCATION [conditionally required for NEW VISITS]
S TIU("HLOC")=$$REMESC^TIUHL7U1($P($P($G(@TIUNAME@(4)),TIUFS,4),TIUCS)) I +$L(TIU("HLOC")) S TIU("HLOC")=+$$LU^TIUHL7U1(44,TIU("HLOC"))
;
; get AUTHOR/DICTATOR SSN or IEN [optional] & NAME [required]
S TIUTMP=$S($P($P($G(@TIUNAME@(5)),TIUFS,10),TIUCS,9)'="USSSA":"AUDA",1:"AUSSN") S @TIU@(TIUTMP)=$P($P($G(@TIUNAME@(5)),TIUFS,10),TIUCS)
S TIU("AUNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($P($P($G(@TIUNAME@(5)),TIUFS,10),TIUCS,2,4),TIUCS)),TIU("AUNAME")=$$REMESC^TIUHL7U1(TIU("AUNAME"))
;
; get EXPECTED COSIGNER SSN or IEN [optional] & NAME [conditionally required]
S TIUTMP=$S($P($P($G(@TIUNAME@(5)),TIUFS,11),TIUCS,9)'="USSSA":"CSDA",1:"CSSSN") S @TIU@(TIUTMP)=$P($P($G(@TIUNAME@(5)),TIUFS,11),TIUCS)
S TIU("CSNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($P($P($G(@TIUNAME@(5)),TIUFS,11),TIUCS,2,4),TIUCS)),TIU("CSNAME")=$$REMESC^TIUHL7U1(TIU("CSNAME"))
;
; get ENTERED BY SSN or IEN [optional] & NAME [optional]
S TIUTMP=$S($P($P($G(@TIUNAME@(5)),TIUFS,12),TIUCS,9)'="USSSA":"EBDA",1:"EBSSN") S @TIU@(TIUTMP)=$P($P($G(@TIUNAME@(5)),TIUFS,12),TIUCS)
S TIU("EBNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($P($P($G(@TIUNAME@(5)),TIUFS,12),TIUCS,2,4),TIUCS)),TIU("EBNAME")=$$REMESC^TIUHL7U1(TIU("EBNAME"))
;
; get SURGICAL CASE or CONSULT # [conditionally required for SURGICAL REPORTS or CONSULT titles]
S TIUTMP=$S($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS"):"CNCN",1:"SRCN") S @TIU@(TIUTMP)=$$REMESC^TIUHL7U1($P($P($G(@TIUNAME@(5)),TIUFS,13),TIUCS))
;
; gets SIGNATURE/COSIGNATURE DATE/TIME [optional]
S TIU("SIGNED")=$$REMESC^TIUHL7U1($P($P($G(@TIUNAME@(5)),TIUFS,23),TIUCS,15)),TIU("CSIGNED")=$$REMESC^TIUHL7U1($P($P($G(@TIUNAME@(5)),TIUFS,23),TIUCS,29))
;
; get DOCUMENT TEXT [required]
S TIUTMP="" F S TIUTMP=$O(@TIUNAME@(TIUTMP)) Q:TIUTMP="" D:$P($G(@TIUNAME@(TIUTMP)),TIUFS)="OBX"
. I $P(@TIUNAME@(TIUTMP),TIUFS,2)=1,$L($G(TIU("SUB")))'>0 S TIU("SUB")=$P($P(@TIUNAME@(TIUTMP),TIUFS,4),TIUCS,2),TIU("SUB")=$$REMESC^TIUHL7U1(TIU("SUB"))
. F TIUI=1:1:$L($P(@TIUNAME@(TIUTMP),TIUFS,6),TIURS) S TIUZ("TEXT",TIUI,0)=$P($P(@TIUNAME@(TIUTMP),TIUFS,6),TIURS,TIUI),TIUZ("TEXT",TIUI,0)=$$STRIP^TIUHL7U2($$REMESC^TIUHL7U1(TIUZ("TEXT",TIUI,0)))
;
; begin data verification
; PATIENT IDENTIFICATION
D
. N TIUI,TIUJ,TIUERR,TIUN,TIUOUT,TIUTMP,TIUQUIT
. I '+$L($G(TIU("PTNAME"))) D ERR^TIUHL7U1("PID",5,"0000.00","Missing PATIENT NAME.")
. ; verify there is at least one piece of numeric PATIENT ID
. S TIUJ=0 F TIUI="ICN","DFN","SSN" S:+$G(TIU(TIUI)) TIUJ=TIUJ+1
. I '+TIUJ D ERR^TIUHL7U1("PID",5,"0000.00","Missing numeric PATIENT ID data; at least one numeric identifier [ICN,SSN,DFN] must be sent.") Q
. I +TIUJ=1 D
. . I '+$L($P(TIU("PTNAME"),",",2)) D ERR^TIUHL7U1("PID",5,"0000.00","FIRST NAME/INITIAL missing with only one numeric identifier sent.")
. . S TIUN("PT")=$$PNAME^TIUHL7U1(TIU("PTNAME")),TIUTMP=1
. E S TIUN("PT")=$P(TIU("PTNAME"),",")
. S TIUJ=0
. ; check DFN if available
. I +$G(TIU("DFN")) S TIUJ=TIUJ+1,DFN(TIUJ)=TIU("DFN") D
. . I +$G(TIUTMP) S TIUN("DFN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,TIU("DFN"),.01))
. . E S TIUN("DFN")=$P($$GET1^DIQ(2,TIU("DFN"),.01),",")
. . I '$$COMPARE^TIUHL7U1(TIUN("DFN"),TIUN("PT")) D ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message DFN #"_TIU("DFN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
. ; check ICN if available
. I +$G(TIU("ICN")) S TIUJ=TIUJ+1,DFN(TIUJ)=+$$FIND1^DIC(2,"","X",TIU("ICN"),"AICN") D
. . I +$G(TIUTMP) S TIUN("ICN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,DFN(TIUJ),.01))
. . E S TIUN("ICN")=$P($$GET1^DIQ(2,DFN(TIUJ),.01),",")
. . I '$$COMPARE^TIUHL7U1(TIUN("ICN"),TIUN("PT")) D ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message ICN #"_TIU("ICN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
. ; check SSN if available
. I +$G(TIU("SSN")) S TIUJ=TIUJ+1,DFN(TIUJ)=+$$FIND1^DIC(2,"","X",TIU("SSN"),"SSN") D
. . I +$G(TIUTMP) S TIUN("SSN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,DFN(TIUJ),.01))
. . E S TIUN("SSN")=$P($$GET1^DIQ(2,DFN(TIUJ),.01),",")
. . I '$$COMPARE^TIUHL7U1(TIUN("SSN"),TIUN("PT")) D ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message SSN #"_TIU("SSN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
. ; compare DFN lookup values
. I TIUJ>1 S (TIUI,TIUJ)=0 F S TIUI=$O(DFN(TIUI)) Q:'TIUI I TIUI>1 S TIUJ=TIUI-1 I DFN(TIUI)'=DFN(TIUJ) D ERR^TIUHL7U1("PID",5,"0000.00","PATIENT IEN discrepancies between the numeric lookups.") Q
. I TIU("EC") Q
. S DFN=DFN(1)
;
D CONTINUE^TIUHL7P2
Q
TIUHL7P1 ; SLC/AJB - TIUHL7 Msg Processing; January 6, 2006
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**200,228**;Jun 20, 1997
+2 QUIT
PROCMSG ;
+1 NEW DFN,DUZ,TIU,TIUDA,TIUDPRM,TIUDT,TIUERR,TIUI,TIUJ,TIUMSG,TIUNAME,TIUTMP,TIUFS,TIUCS,TIURS,TIUES,TIUSS,TIUZ
+2 ;
+3 ; quit if HL7 Message IEN is not present
+4 ;I '+$G(HLMTIENS) Q
+5 ;
+6 ; remove HL7 message entries 7 days or older
+7 DO CLEAN^TIUHL7U1
+8 ;
+9 ; sets field, component and repetition separators from HL7 Message
+10 SET TIUFS=$GET(HL("FS"))
SET TIUJ=0
FOR TIUI="TIUCS","TIURS","TIUES","TIUSS"
SET TIUJ=TIUJ+1
SET @TIUI=$EXTRACT(HL("ECH"),TIUJ,TIUJ)
+11 ;
+12 ; initializes variables and ^XTMP expiration
+13 SET TIU="TIU"
SET (TIU("EC"),TIUDA)=0
SET TIUDT=+$$NOW^XLFDT
SET TIUNAME=$NAME(^XTMP("TIUHL7",TIUDT,HLMTIENS))
SET ^XTMP("TIUHL7",0)=$$FMADD^XLFDT(TIUDT,7)_U_TIUDT
+14 ;
+15 ; retrieves HL7 message and stores to temporary global
+16 FOR TIUI=1:1
XECUTE HLNEXT
IF HLQUIT'>0
QUIT
Begin DoDot:1
+17 SET @TIUNAME@("MSG",TIUI)=HLNODE
SET TIUJ=0
+18 FOR
SET TIUJ=$ORDER(HLNODE(TIUJ))
IF 'TIUJ
QUIT
SET @TIUNAME@("MSG",TIUI)=@TIUNAME@("MSG",TIUI)_HLNODE(TIUJ)
End DoDot:1
+19 ;
+20 ; places temporary global in local meory & adds EOM flag
+21 MERGE TIUMSG=@TIUNAME@("MSG")
+22 SET TIU("XTMP")=TIUNAME
SET TIUNAME="TIUMSG"
SET TIUI=""
SET TIUI=$ORDER(TIUMSG(TIUI),-1)
SET TIUI=TIUI+1
SET TIUMSG(TIUI)="EOM"
+23 ;
+24 ; verify message format
+25 SET TIUI=""
FOR
SET TIUI=$ORDER(@TIUNAME@(TIUI))
IF @TIUNAME@(TIUI)="EOM"
QUIT
Begin DoDot:1
+26 SET TIUJ=$SELECT(TIUI=1:"MSH",TIUI=2:"EVN",TIUI=3:"PID",TIUI=4:"PV1",TIUI=5:"TXA",TIUI=6:"OBX",1:"OBX")
+27 IF $PIECE(@TIUNAME@(TIUI),TIUFS)'=TIUJ
DO ERR^TIUHL7U1("MSG",1,"000.000","Improper/missing message format: "_TIUJ_" segment.")
End DoDot:1
+28 ;
+29 ; if message fails check, quit processing
+30 IF +TIU("EC")
DO ACK^TIUHL7U1("AR",TIUNAME,-1)
QUIT
+31 ;
+32 ; get patient name [required]
+33 SET TIU("PTNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($PIECE($PIECE($GET(@TIUNAME@(3)),TIUFS,6),TIUCS,1,4),TIUCS))
SET TIU("PTNAME")=$$REMESC^TIUHL7U1(TIU("PTNAME"))
+34 ;
+35 ; get patient ICN/SSN/DFN - order may vary [conditionally required]
+36 SET (TIU("DFN"),TIU("ICN"),TIU("SSN"))=""
FOR TIUI=1:1:$LENGTH($PIECE($GET(@TIUNAME@(3)),TIUFS,4),TIURS)
SET TIUJ=$PIECE($PIECE($GET(@TIUNAME@(3)),TIUFS,4),TIURS,TIUI)
IF +TIUJ>0
Begin DoDot:1
+37 SET TIUTMP=$SELECT($PIECE(TIUJ,TIUCS,5)="NI":"ICN",$PIECE(TIUJ,TIUCS,5)="SS":"SSN",$PIECE(TIUJ,TIUCS,5)="PI":"DFN",1:"UNK")
+38 SET @TIU@(TIUTMP)=$$REMESC^TIUHL7U1($PIECE(TIUJ,TIUCS))
IF TIUTMP="ICN"
IF @TIU@(TIUTMP)["V"
SET @TIU@(TIUTMP)=$PIECE(@TIU@(TIUTMP),"V")
End DoDot:1
+39 ;
+40 ; get PATIENT DOB (optional)
+41 SET TIU("DOB")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(3)),TIUFS,8)))
+42 ;
+43 ; get DOCUMENT TITLE (#8925.1) [required] & set IEN
+44 SET TIU("TITLE")=$$UPPER^HLFNC($PIECE($GET(@TIUNAME@(5)),TIUFS,17))
SET TIU("TITLE")=$$REMESC^TIUHL7U1(TIU("TITLE"))
+45 SET TIU("TDA")=$$LU^TIUHL7U1(8925.1,TIU("TITLE"),"X","I $P(^TIU(8925.1,+Y,0),U,4)=""DOC""")
IF $LENGTH(TIU("TITLE"))'>0
SET TIU("TITLE")="[UNKNOWN]"
+46 ;
+47 ; get DOCUMENT AVAILABILITY [optional]
+48 SET TIU("AVAIL")=$$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(5)),TIUFS,20))
+49 ;
+50 ;gets DOCUMENT COMPLETION STATUS [optional]
+51 SET TIU("COMP")=$$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(5)),TIUFS,18))
+52 ;
+53 ; get REFERENCE DATE [required]
+54 SET TIU("RFDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(5)),TIUFS,5)))
IF TIU("RFDT")'>-1
DO ERR^TIUHL7U1("TXA",4,"0000.00","Invalid HL7 date format for ACTIVITY DATE/TIME[REFERENCE DATE/TIME].")
+55 IF +$PIECE(TIU("RFDT"),".")
IF '+$PIECE(TIU("RFDT"),".",2)
SET $PIECE(TIU("RFDT"),".",2)=$PIECE($$NOW^XLFDT,".",2)
+56 ;
+57 ; get EPISODE BEGIN DT/TIME [conditionally required for DISCHARGE SUMMARIES]
+58 SET TIU("EPDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(4)),TIUFS,45)))
IF TIU("EPDT")'>-1
DO ERR^TIUHL7U1("PV1",44,"0000.00","Invalid HL7 date format for ADMIT DATE/TIME [EPISODE BEGIN DATE/TIME].")
+59 IF +$PIECE(TIU("EPDT"),".")
IF '+$PIECE(TIU("EPDT"),".",2)
SET $PIECE(TIU("EPDT"),".",2)=$PIECE($$NOW^XLFDT,".",2)
+60 ;
+61 ; get DICTATION DT/TIME [optional]
+62 SET TIU("DICDT")=$$HL7TFM^XLFDT($$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(5)),TIUFS,7)))
IF TIU("DICDT")'>-1
DO ERR^TIUHL7U1("TXA",6,"0000.00","Invalid HL7 date format for TRANSCRIPTION DATE/TIME[DICTATION DATE/TIME].")
+63 IF +$PIECE(TIU("DICDT"),".")
IF '+$PIECE(TIU("DICDT"),".",2)
SET $PIECE(TIU("DICDT"),".",2)=$PIECE($$NOW^XLFDT,".",2)
+64 ;
+65 ; get VISIT # [optional]
+66 SET TIU("VNUM")=$$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(4)),TIUFS,20))
+67 ;
+68 ; get HOSPITAL LOCATION [conditionally required for NEW VISITS]
+69 SET TIU("HLOC")=$$REMESC^TIUHL7U1($PIECE($PIECE($GET(@TIUNAME@(4)),TIUFS,4),TIUCS))
IF +$LENGTH(TIU("HLOC"))
SET TIU("HLOC")=+$$LU^TIUHL7U1(44,TIU("HLOC"))
+70 ;
+71 ; get AUTHOR/DICTATOR SSN or IEN [optional] & NAME [required]
+72 SET TIUTMP=$SELECT($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,10),TIUCS,9)'="USSSA":"AUDA",1:"AUSSN")
SET @TIU@(TIUTMP)=$PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,10),TIUCS)
+73 SET TIU("AUNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,10),TIUCS,2,4),TIUCS))
SET TIU("AUNAME")=$$REMESC^TIUHL7U1(TIU("AUNAME"))
+74 ;
+75 ; get EXPECTED COSIGNER SSN or IEN [optional] & NAME [conditionally required]
+76 SET TIUTMP=$SELECT($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,11),TIUCS,9)'="USSSA":"CSDA",1:"CSSSN")
SET @TIU@(TIUTMP)=$PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,11),TIUCS)
+77 SET TIU("CSNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,11),TIUCS,2,4),TIUCS))
SET TIU("CSNAME")=$$REMESC^TIUHL7U1(TIU("CSNAME"))
+78 ;
+79 ; get ENTERED BY SSN or IEN [optional] & NAME [optional]
+80 SET TIUTMP=$SELECT($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,12),TIUCS,9)'="USSSA":"EBDA",1:"EBSSN")
SET @TIU@(TIUTMP)=$PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,12),TIUCS)
+81 SET TIU("EBNAME")=$$UPPER^HLFNC($$FMNAME^HLFNC($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,12),TIUCS,2,4),TIUCS))
SET TIU("EBNAME")=$$REMESC^TIUHL7U1(TIU("EBNAME"))
+82 ;
+83 ; get SURGICAL CASE or CONSULT # [conditionally required for SURGICAL REPORTS or CONSULT titles]
+84 SET TIUTMP=$SELECT($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS"):"CNCN",1:"SRCN")
SET @TIU@(TIUTMP)=$$REMESC^TIUHL7U1($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,13),TIUCS))
+85 ;
+86 ; gets SIGNATURE/COSIGNATURE DATE/TIME [optional]
+87 SET TIU("SIGNED")=$$REMESC^TIUHL7U1($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,23),TIUCS,15))
SET TIU("CSIGNED")=$$REMESC^TIUHL7U1($PIECE($PIECE($GET(@TIUNAME@(5)),TIUFS,23),TIUCS,29))
+88 ;
+89 ; get DOCUMENT TEXT [required]
+90 SET TIUTMP=""
FOR
SET TIUTMP=$ORDER(@TIUNAME@(TIUTMP))
IF TIUTMP=""
QUIT
IF $PIECE($GET(@TIUNAME@(TIUTMP)),TIUFS)="OBX"
Begin DoDot:1
+91 IF $PIECE(@TIUNAME@(TIUTMP),TIUFS,2)=1
IF $LENGTH($GET(TIU("SUB")))'>0
SET TIU("SUB")=$PIECE($PIECE(@TIUNAME@(TIUTMP),TIUFS,4),TIUCS,2)
SET TIU("SUB")=$$REMESC^TIUHL7U1(TIU("SUB"))
+92 FOR TIUI=1:1:$LENGTH($PIECE(@TIUNAME@(TIUTMP),TIUFS,6),TIURS)
SET TIUZ("TEXT",TIUI,0)=$PIECE($PIECE(@TIUNAME@(TIUTMP),TIUFS,6),TIURS,TIUI)
SET TIUZ("TEXT",TIUI,0)=$$STRIP^TIUHL7U2($$REMESC^TIUHL7U1(TIUZ("TEXT",TIUI,0)))
End DoDot:1
+93 ;
+94 ; begin data verification
+95 ; PATIENT IDENTIFICATION
+96 Begin DoDot:1
+97 NEW TIUI,TIUJ,TIUERR,TIUN,TIUOUT,TIUTMP,TIUQUIT
+98 IF '+$LENGTH($GET(TIU("PTNAME")))
DO ERR^TIUHL7U1("PID",5,"0000.00","Missing PATIENT NAME.")
+99 ; verify there is at least one piece of numeric PATIENT ID
+100 SET TIUJ=0
FOR TIUI="ICN","DFN","SSN"
IF +$GET(TIU(TIUI))
SET TIUJ=TIUJ+1
+101 IF '+TIUJ
DO ERR^TIUHL7U1("PID",5,"0000.00","Missing numeric PATIENT ID data; at least one numeric identifier [ICN,SSN,DFN] must be sent.")
QUIT
+102 IF +TIUJ=1
Begin DoDot:2
+103 IF '+$LENGTH($PIECE(TIU("PTNAME"),",",2))
DO ERR^TIUHL7U1("PID",5,"0000.00","FIRST NAME/INITIAL missing with only one numeric identifier sent.")
+104 SET TIUN("PT")=$$PNAME^TIUHL7U1(TIU("PTNAME"))
SET TIUTMP=1
End DoDot:2
+105 IF '$TEST
SET TIUN("PT")=$PIECE(TIU("PTNAME"),",")
+106 SET TIUJ=0
+107 ; check DFN if available
+108 IF +$GET(TIU("DFN"))
SET TIUJ=TIUJ+1
SET DFN(TIUJ)=TIU("DFN")
Begin DoDot:2
+109 IF +$GET(TIUTMP)
SET TIUN("DFN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,TIU("DFN"),.01))
+110 IF '$TEST
SET TIUN("DFN")=$PIECE($$GET1^DIQ(2,TIU("DFN"),.01),",")
+111 IF '$$COMPARE^TIUHL7U1(TIUN("DFN"),TIUN("PT"))
DO ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message DFN #"_TIU("DFN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
End DoDot:2
+112 ; check ICN if available
+113 IF +$GET(TIU("ICN"))
SET TIUJ=TIUJ+1
SET DFN(TIUJ)=+$$FIND1^DIC(2,"","X",TIU("ICN"),"AICN")
Begin DoDot:2
+114 IF +$GET(TIUTMP)
SET TIUN("ICN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,DFN(TIUJ),.01))
+115 IF '$TEST
SET TIUN("ICN")=$PIECE($$GET1^DIQ(2,DFN(TIUJ),.01),",")
+116 IF '$$COMPARE^TIUHL7U1(TIUN("ICN"),TIUN("PT"))
DO ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message ICN #"_TIU("ICN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
End DoDot:2
+117 ; check SSN if available
+118 IF +$GET(TIU("SSN"))
SET TIUJ=TIUJ+1
SET DFN(TIUJ)=+$$FIND1^DIC(2,"","X",TIU("SSN"),"SSN")
Begin DoDot:2
+119 IF +$GET(TIUTMP)
SET TIUN("SSN")=$$PNAME^TIUHL7U1($$GET1^DIQ(2,DFN(TIUJ),.01))
+120 IF '$TEST
SET TIUN("SSN")=$PIECE($$GET1^DIQ(2,DFN(TIUJ),.01),",")
+121 IF '$$COMPARE^TIUHL7U1(TIUN("SSN"),TIUN("PT"))
DO ERR^TIUHL7U1("PID",5,"0000.00","PATIENT NAME discrepancy between HL7 message name ["_TIU("PTNAME")_"] & the HL7 message SSN #"_TIU("SSN")_" ["_$$GET1^DIQ(2,DFN(TIUJ),.01)_"].")
End DoDot:2
+122 ; compare DFN lookup values
+123 IF TIUJ>1
SET (TIUI,TIUJ)=0
FOR
SET TIUI=$ORDER(DFN(TIUI))
IF 'TIUI
QUIT
IF TIUI>1
SET TIUJ=TIUI-1
IF DFN(TIUI)'=DFN(TIUJ)
DO ERR^TIUHL7U1("PID",5,"0000.00","PATIENT IEN discrepancies between the numeric lookups.")
QUIT
+124 IF TIU("EC")
QUIT
+125 SET DFN=DFN(1)
End DoDot:1
+126 ;
+127 DO CONTINUE^TIUHL7P2
+128 QUIT
