TIUCCRHL7P1.m

TIUCCRHL7P1 ; CCRA/PB - TIU CCRA HL7 Msg Processing; January 6, 2006

 ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,348,349,352,356,366,371**;Sep 27, 2023;Build 4

 ;

 ;PB - Patch 344 to modify how the note and addendum text is formatted

 ;PB - Patch 348 modification to parse the note text from NTE segments rather than the OBX segment

 ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult

 ;NOTES FROM NOV 10: Need to loop thru the XTMP("TIUHL7" temp global and if the last character is 

 ;$C(160), remove it.

 ;PB - Patch 352 removes the text CF#: from the CFNOTE

 ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult

 ;PB - Patch 371 removes unused code

 Q

PROCMSG ;

 N DFN,DUZ,CONSULTID,MSGID,TIU,TIUDA,TIUDPRM,TIUDT,TIUERR,TIUI,TIUJ,TIUMSG,TIUELS,STOP,TIUIEN,NOTEDATE,NOTENUM

 N TIUEMAIL,TIUNAME,TIUTMP,TIUFS,TIUCS,TIURS,TIUES,TIUSS,TIUZ,VNUM,MSGTEXT,ADDENDUM,CFNOTE,ORIGSTAT,CONSULTID

 S ADDENDUM=""

 ; remove HL7 message entries7 days or older

 D CLEAN^TIUHL7U1

 S U="^"

 S TIUDT=$$NOW^XLFDT

 ; 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,TIUNAME=$NA(^XTMP("TIUHL7",TIUDT,HLMTIENS)),^XTMP("TIUHL7",0)=$$FMADD^XLFDT(TIUDT,7)_U_TIUDT

 S MSGID=HL("MID")

 ; 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  D

 . . S @TIUNAME@("MSG",TIUI)=@TIUNAME@("MSG",TIUI)_HLNODE(TIUJ)  ;$$TIUC^TIUCCHL7UT(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",TIUI>6:"NTE",1:"OBX")

 . I $P(@TIUNAME@(TIUI),TIUFS)'=TIUJ D ERR^TIUCCHL7UT("MSG",1,"000.000","Improper/missing message format: "_TIUJ_" segment.")

 ; get consult id

 S CONSULTID=$$REMESC^TIUHL7U1($P($G(@TIUNAME@(4)),TIUFS,20))

 ; 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)),U,4),TIURS) S TIUJ=$P($P($G(@TIUNAME@(3)),TIUFS,4),TIURS,TIUI) I +TIUJ>0 D

 . S TIU("ICN")=+$P(TIUJ,U,1)

 I +$G(TIU("ICN"))'>0 S MSGTEXT="Patient ICN not in HL7 message.",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID))

 Q:$G(STOP)=1

 Q:+$G(TIU("ICN"))'>0

 S (DFN,TIU("DFN"))=$$GETDFN^MPIF001($P(TIU("ICN"),"V")),TIU("SSN")=$$GET1^DIQ(2,TIU("DFN")_",",.09,"I")

 S TIUTMP=$S($P(TIUJ,TIUCS,5)="NI":"ICN",$P(TIUJ,TIUCS,5)="SS":"SSN",$P(TIUJ,TIUCS,5)="PI":"DFN",1:"UNK")

 I +TIU("DFN")=-1 S MSGTEXT="Patient not found on VistA ",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID))

 Q:$G(STOP)=1

 Q:+TIU("DFN")=-1

 ; get DOCUMENT TITLE (#8925.1) [required] & set IEN, document title is in TIU("TITLE")

 S TIU("TITLE")=$$UPPER^HLFNC($P($G(@TIUNAME@(5)),TIUFS,17)),TIU("TITLE")=$$REMESC^TIUHL7U1(TIU("TITLE"))

 S TIU("TITLEB")=$$UPPER^HLFNC($P($G(@TIUNAME@(5)),TIUFS,3)),TIU("TITLEB")=$$REMESC^TIUHL7U1(TIU("TITLEB")),TIU("TITLEB")=$P(TIU("TITLEB"),"^",2)

 ;patch 344 code below to determine if this is an original note or an addendum

 I $G(TIU("TITLEB"))["ADDENDUM" D

 .K T2 S T2(" - ")="-" S TIU("TITLEB")=$$REPLACE^XLFSTR(TIU("TITLEB"),.T2) K T2

 .S:$G(TIU("TITLEB"))["ADDENDUM" ADDENDUM=$P(TIU("TITLEB"),"-",2)

 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 VISIT # [optional]

 S:$G(TIU("VNUM"))'="" TIU("AVAIL")="AV",TIU("COMP")="LA"

 ;line of code added below to test filing a note but not linking it to a consult

 S TIU("AVAIL")="AV",TIU("COMP")="LA"

 S TIU("SIGNED")=$$NOW^TIULC,TIU("CSIGNED")=""

 S TIUEMAIL=$$LOW^XLFSTR($P($G(@TIUNAME@(5)),TIUFS,10))

 I $L(TIUEMAIL)'>0 S MSGTEXT="Missing or invalid VA Email Address.",STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID))

 Q:$G(STOP)=1

 Q:$L(TIUEMAIL)'>0

 S (TIU("AUIEN"),TIU("AUDA"))=$O(^VA(200,"ADUPN",TIUEMAIL,""))

 I $L(TIU("AUIEN"))'>0 S MSGTEXT="No valid User Account for "_$G(TIUEMAIL),STOP=1 D MESSAGE^TIUCCRHL7P3(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID))

 Q:$G(STOP)=1

 Q:$L(TIU("AUIEN"))'>0

 S TIU("AUNAME")=$$UPPER^HLFNC($P(^VA(200,TIU("AUIEN"),0),U,1))

 S TIU("AUNAME")=$$REMESC^TIUHL7U1(TIU("AUNAME"))

 S TIU("ELESIG")=$$GET1^DIQ(200,TIU("AUIEN"),20.4)

 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) D

 . . S TIUZ("TEXT",TIUI,0)=$P($P(@TIUNAME@(TIUTMP),TIUFS,6),TIURS,TIUI)

 . . S TIUZ("TEXT",TIUI,0)=$$STRIP^TIUHL7U2($$REMESC^TIUHL7U1(TIUZ("TEXT",TIUI,0)))

 I $L(@TIUNAME@(7))>0&($E(@TIUNAME@(7),1,3)="NTE") D

 .N X1X,XCNTX S XCNTX=1,X1X=6 F  S X1X=$O(@TIUNAME@(X1X)) Q:X1X'>""  D

 ..S TIUZ("TEXT",XCNTX,0)=$TR($P($G(@TIUNAME@(X1X)),"|",4),$C(160)," ")

 ..I $G(TIUZ("TEXT",XCNTX,0))["'" D

 ...N SPEC,T5 S SPEC("'")="'",T5=TIUZ("TEXT",XCNTX,0)

 ...S TIUZ("TEXT",XCNTX,0)=$$REPLACE^XLFSTR(T5,.SPEC)

 ..I $G(TIUZ("TEXT",XCNTX,0))[""" D

 ...N SPEC,T5 S SPEC(""")="""",T5=TIUZ("TEXT",XCNTX,0)

 ...S TIUZ("TEXT",XCNTX,0)=$$REPLACE^XLFSTR(T5,.SPEC)

 ..I $G(TIUZ("TEXT",XCNTX,0))["Original CCP Note Date (mm/dd/yyyy):" S NOTEDATE=$P(TIUZ("TEXT",XCNTX,0),":",2)

 ..I $G(TIUZ("TEXT",XCNTX,0))["CCPN Number:" S NOTENUM=$P(TIUZ("TEXT",XCNTX,0),":",2)

 ..I $G(TIUZ("TEXT",XCNTX,0))'=""&($L(TIUZ("TEXT",XCNTX,0))>80) D SPLIT(TIUZ("TEXT",XCNTX,0),XCNTX)

 ..;patch 349, PB - Feb 15, 2022 - modifications to capture the Consult Factor text to be filed as a comment with the consult

 ..I $G(TIUZ("TEXT",XCNTX,0))["CF#:" S CFNOTE=$P($G(TIUZ("TEXT",XCNTX,0)),"CF#: ",2)

 ..S XCNTX=XCNTX+1

 I '$D(@TIUNAME@(7)) D

 .D:$G(ADDENDUM)="" WORD

 .D:$G(ADDENDUM)'="" WORD^TIUCCRHL7P4

 ; begin data verification

 ; PATIENT IDENTIFICATION

 D

 .Q

 . N TIUI,TIUJ,TIUERR,TIUN,TIUOUT,TIUTMP,TIUQUIT

 . I $D(TIU("DFN")) S TIUJ=1

 . I '+$L($G(TIU("PTNAME"))) D ERR^TIUCCHL7UT("PID",5,"0000.00","Missing PATIENT NAME.")

 . I +TIUJ=1 D

 . . I '+$L($P(TIU("PTNAME"),",",2)) D ERR^TIUCCHL7UT("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^TIUCCHL7UT("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^TIUCCHL7UT("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^TIUCCHL7UT("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^TIUCCHL7UT("PID",5,"0000.00","PATIENT IEN discrepancies between the numeric lookups.") Q

 . I TIU("EC") Q

 . S DFN=DFN(1)

 I $G(ADDENDUM)'="" D

 .N N1 S N1=0 F  S N1=$O(TIUZ("TEXT",N1)) Q:N1'>0  D

 ..I $G(TIUZ("TEXT",N1,0))["Original CCP Note Date (mm/dd/yyyy):" S NOTEDATE=$P(TIUZ("TEXT",N1,0),": ",2)

 ..I $G(TIUZ("TEXT",N1,0))["CCPN Number:" S NOTENUM=$P(TIUZ("TEXT",N1,0),": ",2)

 .S:$G(NOTENUM)'="" TIUIEN=$$TIULKUP^TIUCCHL7UT(CONSULTID,TIU("TDA"),$G(NOTEDATE),NOTENUM)

 ;

 D CONTINUE^TIUCCRHL7P2

 Q

SPLIT(NODE,CNTR) ;

 Q:$G(NODE)=""

 Q:$G(CNTR)=""

 Q:$L(NODE)<80

 K LINE

 S NODE=$TR(NODE,$C(160),""),XCNTX=CNTR

 N WORDS,I,XX,SEGS,LEN

 S LEN=$L(NODE),SEGS=LEN/80 S:$P(SEGS,".",2)>0 SEGS=SEGS+1

 S WORDS=0 F I=1:1:$L(NODE) I $E(NODE,I)=" " S WORDS=WORDS+1

 S XX="",CNT=1,LASTWORD=0

 F I=1:1:(WORDS+1) D

 .S XX=XX_$P(NODE," ",I)_" "

 .I $L(XX)>80 D

 ..S LASTWORD=I

 ..S LINE(CNT)=XX,CNT=CNT+1 S XX="",TIUZ("TEXT",XCNTX,0)=$G(LINE(CNT-1)),XCNTX=XCNTX+1

 I ((WORDS+1)>LASTWORD) D

 .S LINE(CNT)=$P(NODE," ",LASTWORD+1,WORDS+1),TIUZ("TEXT",XCNTX,0)=$G(LINE(CNT)),XCNTX=XCNTX+1

 K I,CNT,LASTWORD

 Q

WORD ;

 K I1,CNT,LCNT,LEN,I,LINES,T2,LASTWORDS,TEST1,WORDS,WORDSLEN,XX,T2,T4,T5

 S WORDS=$G(TIUZ("TEXT",1,0)),WORDSLEN=$L(TIUZ("TEXT",1,0))

 I $G(ADDENDUM)'="" D

 .S NOTEDATE=$$GETDATE^TIUCCRHL7P4

 .S NOTENUM=$$NOTENUM^TIUCCRHL7P4

 .S:$G(NOTENUM)'="" TIUIEN=$$TIULKUP^TIUCCHL7UT(CONSULTID,TIU("TDA"),NOTEDATE,NOTENUM) ;Patch 344 lookup the note in the consult to file the addendum with

 F TEST1=1:1:WORDSLEN S LASTWORDS=$E(TIUZ("TEXT",1,0),WORDSLEN,(WORDSLEN-25))

 K T2 S T2("PROVIDER"_$C(160)_"CONTACT ADDENDUM")="PROVIDER CONTACT ADDENDUM"

 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("CCP Note Create Date:")=$C(10)_"CCP Note Create Date:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("CCPN Number:")=$C(10)_"CCPN Number:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran Last Name:")=$C(10)_"Veteran Last Name:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran First Name:")=$C(10)_"Veteran First Name:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran Social:")=$C(10)_"Veteran Social:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2($C(160)_$C(160)_"CONSULT AND REFERRAL INFORMATION ")=$C(10)_"CONSULT AND REFERRAL INFORMATION " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Name of Referring VA Provider:")=$C(10)_"Name of Referring VA Provider:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Selected SEOC:")=$C(10)_"Selected SEOC:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Referral Number:")=$C(10)_"Referral Number:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Unique Consult ID:")=$C(10)_"Unique Consult ID:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Patient Admitted (Yes/No): If yes, then please complete the Discharge Planning Addendum.")=$C(10)_"Patient Admitted (Yes/No): If yes, then please complete the Discharge Planning Addendum" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Chief Complaint: "_$C(160))=$C(10)_"Chief Complaint:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Risks")=$C(10)_"Risks x" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Level of Care Coordination: ")=$C(10)_"Level of Care Coordination: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2,T4 S T4="BasicPlease review all notes, this note may have one or more of the following addenda associated:" D

 .K T5 S T5="Basic Please review all notes, this note may have one or more of the following addenda associated:"

 .S T2($G(T4))=$C(10)_$G(T5) S WORDS=$$REPLACE^XLFSTR(WORDS,.T2) K T5

 K T2 S T2("Care Coordination Follow Up:")=$C(10)_"Care Coordination Follow Up:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Appointment Management:")=$C(10)_"Appointment Management:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Case Management:")=$C(10)_"Case Management:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Continued Stay Review:")=$C(10)_"Continued Stay Review:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Disease Management:")=$C(10)_"Disease Management:"  S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Discharge Planning:")=$C(10)_"Discharge Planning: " S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Discharge Disposition:")=$C(10)_"Discharge Disposition:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran Contact: ")=$C(10)_"Veteran Contact:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Provider Contact: ")=$C(10)_"Provider Contact:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Transfer:")=$C(10)_"Transfer:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran Handoff:")=$C(10)_"Veteran Handoff:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("FACILITY COMMUNITY CARE OFFICE CONTACT")=$C(10)_"FACILITY COMMUNITY CARE OFFICE CONTACT" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Care Coordination Point of Contact:")=$C(10)_"Care Coordination Point of Contact:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("  Phone Number:")=$C(10)_"Phone Number:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2,T4 S T4="Is Veteran's caregiver same as next of kin listed in the demographic section of CPRS (Yes/No)?:" D

 .S T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("If no, provide the following:")=$C(160)_"If no, provider the following:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Veteran's Caregiver Point of Contact:")=$C(10)_"Veteran's Caregiver Point of Contact" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Caregiver's Relationship to Veteran:")=$C(10)_"Caregiver's Relationship to Veteran:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Caregiver's Primary Phone Number:")=$C(10)_"Caregiver's Primary Phone Number::" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("Caregiver's Alternate Phone Number:")=$C(10)_"Caregiver's Alternate Phone Number:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("PLAN:")=$C(10)_"PLAN:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2,T4 S T4="*** CC Plan may include specialty and associated appointment information, date of surgery, post-op needs, post d/c appointment, and any other care coordination plan ***" D

 .S T2(T4)=$C(10)_T4 S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 K T2 S T2("ADDITIONAL NOTES:")=$C(10)_"ADDITIONAL NOTES:" S WORDS=$$REPLACE^XLFSTR(WORDS,.T2)

 S LEN=$L(WORDS),I1=1,XX=1,CNT=0,LCNT=0

 F I=1:1:LEN D

 .S LCNT=LCNT+1

 .I LCNT>100&($E(WORDS,I)=" ")!($E(WORDS,I)=$C(160))!($E(WORDS,I)=$C(10)) D

 ..S:XX=1 LINES("TEXT",XX,0)=$$TRIM^XLFSTR($E(WORDS,1,63),"LR"),XX=XX+1,I=64,LCNT=0,I1=I

 ..Q:XX=1

 ..S LINES("TEXT",XX,0)=$TR($E(WORDS,I1,I-1),$C(160)," "),LINES("TEXT",XX,0)=$$TRIM^XLFSTR(LINES("TEXT",XX,0),"LR"),XX=XX+1,LCNT=0  ;,I1=I

 ..S I1=I

 I I1'=LEN N LASTLINES S LASTLINES=$E(WORDS,I1,I) K T2 S T2($C(160)_" ")="" S LINES("TEXT",XX,0)=$$REPLACE^XLFSTR(LASTLINES,.T2)

 M TIUZ("TEXT")=LINES("TEXT")

 K LINES("TEXT")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---TIUCCRHL7P1   15733     printed  Feb 19, 2025@00:05:34                                                                                                                                                                                                Page 2

TIUCCRHL7P1 ; CCRA/PB - TIU CCRA HL7 Msg Processing; January 6, 2006

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,348,349,352,356,366,371**;Sep 27, 2023;Build 4

 +2       ;

 +3       ;PB - Patch 344 to modify how the note and addendum text is formatted

 +4       ;PB - Patch 348 modification to parse the note text from NTE segments rather than the OBX segment

 +5       ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult

 +6       ;NOTES FROM NOV 10: Need to loop thru the XTMP("TIUHL7" temp global and if the last character is 

 +7       ;$C(160), remove it.

 +8       ;PB - Patch 352 removes the text CF#: from the CFNOTE

 +9       ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult

 +10      ;PB - Patch 371 removes unused code

 +11       QUIT 

PROCMSG   ;

 +1        NEW DFN,DUZ,CONSULTID,MSGID,TIU,TIUDA,TIUDPRM,TIUDT,TIUERR,TIUI,TIUJ,TIUMSG,TIUELS,STOP,TIUIEN,NOTEDATE,NOTENUM

 +2        NEW TIUEMAIL,TIUNAME,TIUTMP,TIUFS,TIUCS,TIURS,TIUES,TIUSS,TIUZ,VNUM,MSGTEXT,ADDENDUM,CFNOTE,ORIGSTAT,CONSULTID

 +3        SET ADDENDUM=""

 +4       ; remove HL7 message entries7 days or older

 +5        DO CLEAN^TIUHL7U1

 +6        SET U="^"

 +7        SET TIUDT=$$NOW^XLFDT

 +8       ; sets field, component and repetition separators from HL7 Message

 +9        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)

 +10      ; initializes variables and ^XTMP expiration

 +11       SET TIU="TIU"

           SET (TIU("EC"),TIUDA)=0

           SET TIUNAME=$NAME(^XTMP("TIUHL7",TIUDT,HLMTIENS))

           SET ^XTMP("TIUHL7",0)=$$FMADD^XLFDT(TIUDT,7)_U_TIUDT

 +12       SET MSGID=HL("MID")

 +13      ; retrieves HL7 message and stores to temporary global

 +14       FOR TIUI=1:1

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT 

               Begin DoDot:1

 +15               SET @TIUNAME@("MSG",TIUI)=HLNODE

                   SET TIUJ=0

 +16               FOR 

                       SET TIUJ=$ORDER(HLNODE(TIUJ))

                       if 'TIUJ

                           QUIT 

                       Begin DoDot:2

 +17      ;$$TIUC^TIUCCHL7UT(HLNODE(TIUJ))

                           SET @TIUNAME@("MSG",TIUI)=@TIUNAME@("MSG",TIUI)_HLNODE(TIUJ)

                       End DoDot:2

               End DoDot:1

 +18      ; places temporary global in local meory & adds EOM flag

 +19       MERGE TIUMSG=@TIUNAME@("MSG")

 +20       SET TIU("XTMP")=TIUNAME

           SET TIUNAME="TIUMSG"

           SET TIUI=""

           SET TIUI=$ORDER(TIUMSG(TIUI),-1)

           SET TIUI=TIUI+1

           SET TIUMSG(TIUI)="EOM"

 +21      ; verify message format

 +22       SET TIUI=""

           FOR 

               SET TIUI=$ORDER(@TIUNAME@(TIUI))

               if @TIUNAME@(TIUI)="EOM"

                   QUIT 

               Begin DoDot:1

 +23               SET TIUJ=$SELECT(TIUI=1:"MSH",TIUI=2:"EVN",TIUI=3:"PID",TIUI=4:"PV1",TIUI=5:"TXA",TIUI=6:"OBX",TIUI>6:"NTE",1:"OBX")

 +24               IF $PIECE(@TIUNAME@(TIUI),TIUFS)'=TIUJ

                       DO ERR^TIUCCHL7UT("MSG",1,"000.000","Improper/missing message format: "_TIUJ_" segment.")

               End DoDot:1

 +25      ; get consult id

 +26       SET CONSULTID=$$REMESC^TIUHL7U1($PIECE($GET(@TIUNAME@(4)),TIUFS,20))

 +27      ; get patient name [required]

 +28       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"))

 +29      ; get patient ICN/SSN/DFN - order may vary [conditionally required]

 +30       SET (TIU("DFN"),TIU("ICN"),TIU("SSN"))=""

           FOR TIUI=1:1:$LENGTH($PIECE($GET(@TIUNAME@(3)),U,4),TIURS)

               SET TIUJ=$PIECE($PIECE($GET(@TIUNAME@(3)),TIUFS,4),TIURS,TIUI)

               IF +TIUJ>0

                   Begin DoDot:1

 +31                   SET TIU("ICN")=+$PIECE(TIUJ,U,1)

                   End DoDot:1

 +32       IF +$GET(TIU("ICN"))'>0

               SET MSGTEXT="Patient ICN not in HL7 message."

               SET STOP=1

               DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)

               DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))

 +33       if $GET(STOP)=1

               QUIT 

 +34       if +$GET(TIU("ICN"))'>0

               QUIT 

 +35       SET (DFN,TIU("DFN"))=$$GETDFN^MPIF001($PIECE(TIU("ICN"),"V"))

           SET TIU("SSN")=$$GET1^DIQ(2,TIU("DFN")_",",.09,"I")

 +36       SET TIUTMP=$SELECT($PIECE(TIUJ,TIUCS,5)="NI":"ICN",$PIECE(TIUJ,TIUCS,5)="SS":"SSN",$PIECE(TIUJ,TIUCS,5)="PI":"DFN",1:"UNK")

 +37       IF +TIU("DFN")=-1

               SET MSGTEXT="Patient not found on VistA "

               SET STOP=1

               DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)

               DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))

 +38       if $GET(STOP)=1

               QUIT 

 +39       if +TIU("DFN")=-1

               QUIT 

 +40      ; get DOCUMENT TITLE (#8925.1) [required] & set IEN, document title is in TIU("TITLE")

 +41       SET TIU("TITLE")=$$UPPER^HLFNC($PIECE($GET(@TIUNAME@(5)),TIUFS,17))

           SET TIU("TITLE")=$$REMESC^TIUHL7U1(TIU("TITLE"))

 +42       SET TIU("TITLEB")=$$UPPER^HLFNC($PIECE($GET(@TIUNAME@(5)),TIUFS,3))

           SET TIU("TITLEB")=$$REMESC^TIUHL7U1(TIU("TITLEB"))

           SET TIU("TITLEB")=$PIECE(TIU("TITLEB"),"^",2)

 +43      ;patch 344 code below to determine if this is an original note or an addendum

 +44       IF $GET(TIU("TITLEB"))["ADDENDUM"

               Begin DoDot:1

 +45               KILL T2

                   SET T2(" - ")="-"

                   SET TIU("TITLEB")=$$REPLACE^XLFSTR(TIU("TITLEB"),.T2)

                   KILL T2

 +46               if $GET(TIU("TITLEB"))["ADDENDUM"

                       SET ADDENDUM=$PIECE(TIU("TITLEB"),"-",2)

               End DoDot:1

 +47       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]"

 +48      ; get VISIT # [optional]

 +49       if $GET(TIU("VNUM"))'=""

               SET TIU("AVAIL")="AV"

               SET TIU("COMP")="LA"

 +50      ;line of code added below to test filing a note but not linking it to a consult

 +51       SET TIU("AVAIL")="AV"

           SET TIU("COMP")="LA"

 +52       SET TIU("SIGNED")=$$NOW^TIULC

           SET TIU("CSIGNED")=""

 +53       SET TIUEMAIL=$$LOW^XLFSTR($PIECE($GET(@TIUNAME@(5)),TIUFS,10))

 +54       IF $LENGTH(TIUEMAIL)'>0

               SET MSGTEXT="Missing or invalid VA Email Address."

               SET STOP=1

               DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)

               DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))

 +55       if $GET(STOP)=1

               QUIT 

 +56       if $LENGTH(TIUEMAIL)'>0

               QUIT 

 +57       SET (TIU("AUIEN"),TIU("AUDA"))=$ORDER(^VA(200,"ADUPN",TIUEMAIL,""))

 +58       IF $LENGTH(TIU("AUIEN"))'>0

               SET MSGTEXT="No valid User Account for "_$GET(TIUEMAIL)

               SET STOP=1

               DO MESSAGE^TIUCCRHL7P3(MSGID,$GET(CONSULTID),MSGTEXT)

               DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))

 +59       if $GET(STOP)=1

               QUIT 

 +60       if $LENGTH(TIU("AUIEN"))'>0

               QUIT 

 +61       SET TIU("AUNAME")=$$UPPER^HLFNC($PIECE(^VA(200,TIU("AUIEN"),0),U,1))

 +62       SET TIU("AUNAME")=$$REMESC^TIUHL7U1(TIU("AUNAME"))

 +63       SET TIU("ELESIG")=$$GET1^DIQ(200,TIU("AUIEN"),20.4)

 +64       SET TIUTMP=""

           FOR 

               SET TIUTMP=$ORDER(@TIUNAME@(TIUTMP))

               if TIUTMP=""

                   QUIT 

               if $PIECE($GET(@TIUNAME@(TIUTMP)),TIUFS)="OBX"

                   Begin DoDot:1

 +65                   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"))

 +66                   FOR TIUI=1:1:$LENGTH($PIECE(@TIUNAME@(TIUTMP),TIUFS,6),TIURS)

                           Begin DoDot:2

 +67                           SET TIUZ("TEXT",TIUI,0)=$PIECE($PIECE(@TIUNAME@(TIUTMP),TIUFS,6),TIURS,TIUI)

 +68                           SET TIUZ("TEXT",TIUI,0)=$$STRIP^TIUHL7U2($$REMESC^TIUHL7U1(TIUZ("TEXT",TIUI,0)))

                           End DoDot:2

                   End DoDot:1

 +69       IF $LENGTH(@TIUNAME@(7))>0&($EXTRACT(@TIUNAME@(7),1,3)="NTE")

               Begin DoDot:1

 +70               NEW X1X,XCNTX

                   SET XCNTX=1

                   SET X1X=6

                   FOR 

                       SET X1X=$ORDER(@TIUNAME@(X1X))

                       if X1X'>""

                           QUIT 

                       Begin DoDot:2

 +71                       SET TIUZ("TEXT",XCNTX,0)=$TRANSLATE($PIECE($GET(@TIUNAME@(X1X)),"|",4),$CHAR(160)," ")

 +72                       IF $GET(TIUZ("TEXT",XCNTX,0))["'"

                               Begin DoDot:3

 +73                               NEW SPEC,T5

                                   SET SPEC("'")="'"

                                   SET T5=TIUZ("TEXT",XCNTX,0)

 +74                               SET TIUZ("TEXT",XCNTX,0)=$$REPLACE^XLFSTR(T5,.SPEC)

                               End DoDot:3

 +75                       IF $GET(TIUZ("TEXT",XCNTX,0))["""

                               Begin DoDot:3

 +76                               NEW SPEC,T5

                                   SET SPEC(""")=""""

                                   SET T5=TIUZ("TEXT",XCNTX,0)

 +77                               SET TIUZ("TEXT",XCNTX,0)=$$REPLACE^XLFSTR(T5,.SPEC)

                               End DoDot:3

 +78                       IF $GET(TIUZ("TEXT",XCNTX,0))["Original CCP Note Date (mm/dd/yyyy):"

                               SET NOTEDATE=$PIECE(TIUZ("TEXT",XCNTX,0),":",2)

 +79                       IF $GET(TIUZ("TEXT",XCNTX,0))["CCPN Number:"

                               SET NOTENUM=$PIECE(TIUZ("TEXT",XCNTX,0),":",2)

 +80                       IF $GET(TIUZ("TEXT",XCNTX,0))'=""&($LENGTH(TIUZ("TEXT",XCNTX,0))>80)

                               DO SPLIT(TIUZ("TEXT",XCNTX,0),XCNTX)

 +81      ;patch 349, PB - Feb 15, 2022 - modifications to capture the Consult Factor text to be filed as a comment with the consult

 +82                       IF $GET(TIUZ("TEXT",XCNTX,0))["CF#:"

                               SET CFNOTE=$PIECE($GET(TIUZ("TEXT",XCNTX,0)),"CF#: ",2)

 +83                       SET XCNTX=XCNTX+1

                       End DoDot:2

               End DoDot:1

 +84       IF '$DATA(@TIUNAME@(7))

               Begin DoDot:1

 +85               if $GET(ADDENDUM)=""

                       DO WORD

 +86               if $GET(ADDENDUM)'=""

                       DO WORD^TIUCCRHL7P4

               End DoDot:1

 +87      ; begin data verification

 +88      ; PATIENT IDENTIFICATION

 +89       Begin DoDot:1

 +90           QUIT 

 +91           NEW TIUI,TIUJ,TIUERR,TIUN,TIUOUT,TIUTMP,TIUQUIT

 +92           IF $DATA(TIU("DFN"))

                   SET TIUJ=1

 +93           IF '+$LENGTH($GET(TIU("PTNAME")))

                   DO ERR^TIUCCHL7UT("PID",5,"0000.00","Missing PATIENT NAME.")

 +94           IF +TIUJ=1

                   Begin DoDot:2

 +95                   IF '+$LENGTH($PIECE(TIU("PTNAME"),",",2))

                           DO ERR^TIUCCHL7UT("PID",5,"0000.00","FIRST NAME/INITIAL missing with only one numeric identifier sent.")

 +96                   SET TIUN("PT")=$$PNAME^TIUHL7U1(TIU("PTNAME"))

                       SET TIUTMP=1

                   End DoDot:2

 +97          IF '$TEST

                   SET TIUN("PT")=$PIECE(TIU("PTNAME"),",")

 +98           SET TIUJ=0

 +99      ; check DFN if available

 +100          IF +$GET(TIU("DFN"))

                   SET TIUJ=TIUJ+1