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