- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUHL7P1 8800 printed Mar 13, 2025@21:46:33 Page 2
- 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