TIUCCRHL ;LB/PB - Send TIU Notes MDM-T02 HL7 Message to CCRA/HSRM ;02/01/19 09:00
;;1.0;TEXT INTEGRATION UTILITIES;**323,327,329**;Oct 24, 2019;Build 42
;This patch requires:
;four (4) CCRA TIU Historical Documents :
; 1 COMMUNITY CARE - PATIENT LETTER TITLE
; Std Title: NONVA PROGRESS NOTE
; 2 COMMUNITY CARE- ADMINISTRATIVE REQUEST TITLE
; Std Title: ADMINISTRATIVE NOTE
; 3 COMMUNITY CARE-COORDINATION NOTE TITLE
; Std Title: NONVA PROGRESS NOTE
; 4 COMMUNITY CARE-HOSPITAL NOTIFICATION NOTE TITLE
; Std Title: PRIMARY CARE ADMINISTRATIVE NOTE
;
;DBIA# Supported Reference
;----- --------------------------------
;2161 INIT^HLFNC2
;2164 GENERATE^HLMA
;3267 SSN^DPTLK1
;3630 BLDPID^VAFCQRY
;10103 FMTE^XLFDT, FMTHL7^XLFDT
;10104 UP^XLFSTR
;10106 FMDATE^HLFNC
;1252 OUTPTPR^SDUTL3
;6917 EN^VAFHLIN1
;10106 HLADDR^HLFNC
;2467 OR^ORX8
;2171 NS^XUAF4
;Fileman READ OF 8925:
; .01 DOCUMENT TYPE 0;1 Read w/Fileman
; .02 PATIENT 0;2 Read w/Fileman
; .03 VISIT 0;3 Read w/Fileman
; .04 PARENT DOCUMENT TYPE (P8925.1)
; .05 STATUS 0;5 Read w/Fileman
; .06 PARENT 0;6 Read w/Fileman
; .11 CREDIT STOP CODE ON 0;11 Read w/Fileman
; .07 EPISODE BEGIN DATE/T 0;7 Read w/Fileman
; .13 VISIT TYPE 0;13 Read w/Fileman
; 1202 AUTHOR/DICTATOR 12;2 Read w/Fileman
; 1204 EXPECTED SIGNER 12;4 Read w/Fileman
; 1208 EXPECTED COSIGNER 12;8 Read w/Fileman
; 1211 VISIT LOCATION 12;11 Read w/Fileman
; 1506 COSIGNER NEEDED 15;6 Read w/Fileman
; 1201 ENTRY DATE/TIME 12;1 Read w/Fileman
; 1301 REFERENCE DATE 13;1 Read w/Fileman
; GLOBAL REFERENCE:
; ^TIU(8925,'AAU'
; GLOBAL REFERENCE:
; ^TIU(8925,'ASUP'
; GLOBAL REFERENCE:
; ^TIU(8925,'APT'
; GLOBAL REFERENCE:
; ^TIU(8925,'ACLPT'
;==============================================================
Q
;
EN() ;Entry point to routine called from POSTSIGN^TIULC1 for the CCRA TIU Documents - Historical
;Expects the context has defined: DFN (Patient IEN -^DPT(), DA (TIU document ID:^TIU(8925,DA)
;
N I,GMRCDA,GMRCM,STATUS,POSTSIGC,PARDOCTY,OK,TIUTYP
;SET HL7 VARIABLES
N FS,CS,RS,ES,SS,MID,HLQUIT,HLNODE
N MSG,HDR,SEG,SEGTYPE,MSGARY,LASTSEG,HDRTIME,ABORT,BASEDT,CLINARY,COUNT,PROVDTL
;
I +$G(DA)'>0 S ^TMP("TIUHL7CCRA",$J,"ERR NO TIU Document IEN("_DA_") passed from CPRS")="" Q
;Patch 329 fix thE undefined DFN, occuring when the user comes back in CPRS
;and signs a previously saved and unsigned note
I $G(DFN)="" D
. S DFN=$P($G(^TIU(8925,+DA,0)),"^",2)
. I $G(DFN)="" S ^TMP("TIUHL7CCRA",$J,"ERR NO TIU Document IEN("_DA_") passed from CPRS")="" Q
;
N SNAME,GMRCHL,ZERR,ZCNT,ECH,DATA,GDATA,URG,TYP,RES,EFFDT,PDUZ,PN,ADDR,PH,GMRCP,SENS,DX,DXCODE
N PCP,PCDUZ,PCPN,PCADDR,PCPH
S SNAME="TIU CCRA-HSRM MDM-T02 SERVER"
S GMRCHL("EID")=$$FIND1^DIC(101,,"X",SNAME)
Q:'GMRCHL("EID") D INIT^HLFNC2(GMRCHL("EID"),.GMRCHL)
S ZERR="",ZCNT=0,ECH=$E(GMRCHL("ECH")) ;component separator
S FS=$G(GMRCHL("FS"),"|")
S CS=$E($G(GMRCHL("ECH")),1) S:CS="" CS="^"
S RS=$E($G(GMRCHL("ECH")),2) S:RS="" RS="~"
S ES=$E($G(GMRCHL("ECH")),3) S:ES="" ES="\"
S SS=$E($G(GMRCHL("ECH")),4) S:SS="" SS="&"
S MID=$G(GMRCHL("MID"))
S (HLQUIT,HLNODE)=0
;
S GMRCDA=$G(DA)
S POSTSIGC=""
;Check if document DA passed in has Addenda, and retrieve the most recent one
I $D(^TIU(8925,"DAD",$G(DA)))=10 S GMRCDA=+$O(^TIU(8925,"DAD",$G(DA),99999999),-1)
;
;get TIU Note data in ^TMP
S DATA=$NA(^TMP("TIUHL7CCRA",$J)) K @DATA
;file,record,field,parm,targetarray,errortargetarray,internal
D GETS^DIQ(8925,GMRCDA,"*","IE",DATA)
;File 8925 data IN ^TMP
S GDATA=$NA(^TMP("TIUHL7CCRA",$J,8925,+GMRCDA_","))
;Patch TIU*1*329 fix <undefined> When User picks up an unsigned note from another CPRS session-
;I DFN'=$G(@GDATA@(.02,"I")) S ^TMP("TIUHL7CCRA",$J,"ERR: CPRS Patient DFN :"_DFN_" doesn't match Document Patient DFN: "_$G(@GDATA@(.02,"I")))="" Q
I $G(DFN)'=$G(@GDATA@(.02,"I")) S ^TMP("TIUHL7CCRA",$J,"ERR: CPRS Patient DFN :"_$G(DFN)_" doesn't match Document Patient DFN: "_$G(@GDATA@(.02,"I")))="" Q
;check if addendum DA is passed in and check if it is for Community
S TIUTYP=$G(@GDATA@(.01,"E"))
S OK=1
I TIUTYP="ADDENDUM" D
. ;check if parent title has the POST-SIGNATURE CODE
. S PARDOCTY=+$G(^TIU(8925,$G(DA),0))
. I +$G(PARDOCTY)<=0 S OK=0
. S POSTSIGC=$$GET1^DIQ(8925.1,PARDOCTY_",",4.9)
. I POSTSIGC'["TIUCCRHL" S OK=0 S ^TMP("TIUHL7CCRA",$J,"ERR: TIU ADDENDA IS NOT SETUP TO SEND MHM-T02:"_POSTSIGC)=""
. I $G(@GDATA@(.05,"E"))'="COMPLETED" S OK=0 S ^TMP("TIUHL7CCRA",$J,"ERR: TIU ADDENDA STATUS IS NOT COMPLETED:"_$G(@GDATA@(.05,"E")))=""
I OK<1 Q ;QUIT if addendum and original note does not have the CCRA HL7 trigger code
;
;start creating the segments.
;EVN Segment
; EVN 1-Event Type Code: "T02"
; EVN 3-Recorded Date/Time: 1201 ENTRY DATE/TIME
; EVN 4-Event Reason: can use "O"-Other / "02"-Physician/health practitioner order
; EVN 5-Operator ID: 1202 AUTHOR/DICTATOR IEN(+DUZ)
; EVN 6-Event Occurred: 1301 REFERENCE DATE
; EVN 7-Event Facility: 1211 VISIT LOCATION (P44)
;
S ZCNT=ZCNT+1
S GMRCM(ZCNT)="EVN"_FS_"T02"_FS_FS_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))_FS_"O"_FS_$G(@GDATA@(1202,"I"))
S GMRCM(ZCNT)=GMRCM(ZCNT)_FS_$$FMTHL7^XLFDT($G(@GDATA@(1301,"I")))_FS_$G(@GDATA@(1211,"I"))_CS_$G(@GDATA@(1211,"E"))
;
;PID segment - May be multiple nodes in the return array - make nodes 2-n sub nodes
S DFN=$G(@GDATA@(.02,"I")),ZERR=""
D BLDPID^VAFCQRY(DFN,1,"ALL",.GMRCP,.GMRCHL,ZERR)
S I=0 F S I=$O(GMRCP(I)) Q:'I D
.I I=1 S ZCNT=ZCNT+1,GMRCM(ZCNT)=$TR(GMRCP(I),"""") Q
.S GMRCM(ZCNT,I)=$TR(GMRCP(I),"""")
K GMRCP
;
;PV1 segment
D IN5^VADPT ;VAIP(18)=Attending Physician, VAIP(13,5)=Primary Physician for admission
S ZCNT=ZCNT+1,GMRCM(ZCNT)="PV1"_FS_"1"_FS_$S(VAIP(13):"I",1:"O")_FS_FS_FS_FS_FS_VAIP(18)_FS
I VAIP(5) S $P(GMRCM(ZCNT),FS,4)=VAIP(5) ;location for last movement event
N GMRCDIV
S GMRCDIV=$$NS^XUAF4(DUZ(2)),GMRCDIV=$P(GMRCDIV,CS,2) ; add in division value
N A,B S A=SS_GMRCDIV,B=$P(GMRCM(ZCNT),FS,4),$P(B,CS,4)=A,$P(GMRCM(ZCNT),FS,4)=B K A,B
K GMRCDIV
;
S SENS=$$SSN^DPTLK1(DFN) I SENS["*SENSITIVE*" S $P(GMRCM(ZCNT),FS,17)="R" ;sensitive patient
S $P(GMRCM(ZCNT),FS,18)=VAIP(13,5)
K VAIP
D KVA^VADPT
;
;TXA segment
; TXA.1 Set ID - TXA: "1"
; TXA.2 Document Type: .01 DOCUMENT TYPE
; TXA.4 Activity Date/Time: 1301 REFERENCE DATE
; TXA.8 Edit Date/Time: 1201 ENTRY DATE/TIME
; TXA.12 Unique Document Number: GMRCDA TIU note IEN
; TXA.13 Parent Document Number: GMRCDA/DA TIU note/ADDENDUM IEN
; TXA.16 Unique Document File Name: ADDENDUM Parent Document Title
; XA.17 Document Completion Status: .05 STATUS
S ZCNT=ZCNT+1
S GMRCM(ZCNT)="TXA"_FS_"1"_FS_$G(@GDATA@(.01,"E"))_FS_FS_$$FMTHL7^XLFDT($G(@GDATA@(1301,"I")))_FS_FS_FS_FS_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))
S GMRCM(ZCNT)=GMRCM(ZCNT)_FS_FS_FS_FS_GMRCDA_FS_$G(@GDATA@(.06,"I"))_FS_FS_FS_$G(@GDATA@(.06,"E"))_FS_$G(@GDATA@(.05,"E"))
;
;OBX segment
; OBX.1-Set ID: 1
; OBX.2-Value Type: "TX"
; OBX.3-Observation Identifier:TIU note IEN (GMRCDA)
; OBX.11-Observation result status codes interpretation: F (Final results)
; OBX.14-Date/Time of the Observation: 1201 -TIU ENTRY DATE/TIME
; OBX.16-ResponsibleObserver() : 1204 EXPECTED SIGNER /1208 EXPECTED COSIGNER
N PRSIG1,PRSIG2
S ZCNT=ZCNT+1
S GMRCM(ZCNT)="OBX"_FS_"1"_FS_"TX"_FS_GMRCDA_FS_FS_FS_FS_FS_FS_FS_FS_"F"_FS_FS_FS_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))
S GMRCM(ZCNT)=GMRCM(ZCNT)_FS_FS_$P($G(@GDATA@(1204,"E")),",",1)_CS_$P($G(@GDATA@(1204,"E")),",",2)
S GMRCM(ZCNT)=GMRCM(ZCNT)_SS_$P($G(@GDATA@(1208,"E")),",",1)_CS_$P($G(@GDATA@(1208,"E")),",",2)
;
;NTE segment
D NTE(.GMRCHL)
;
;Send HL7 Message
N HL,HLA,GMRCRES,GMRCHLP
M HL=GMRCHL,HLA("HLS")=GMRCM
M GMRCHL=^XTMP("TIUHL7CCRA","MESSAGE")
D GENERATE^HLMA(GMRCHL("EID"),"LM",1,.GMRCRES,"",.GMRCHLP)
K ^TMP("TIUHL7CCRA",$J)
Q
NTE(HL) ; Find TIU and build NTE segments
N NTECNT,X S NTECNT=1
D AUTHDTTM
; Build NTE for CM^ADDENDED
N GMRCCMP
S GMRCCMP=""
S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_"P"_FS_"Progress Note:"_$G(@GDATA@(.01,"E"))
;check if Document Type is ADDENDUM
S TIUTYP=$G(@GDATA@(.01,"E"))
I TIUTYP="ADDENDUM" D
. S GMRCCMP=$$DATE^GMRCCCRA($G(@GDATA@(1301,"I")),"MM/DD/CCYY")_" ADDENDUM"_" STATUS: "_$$GET1^DIQ(8925,+GMRCDA_",",.05)
S I=0
F S I=$O(@GDATA@(2,I)) Q:+I=0 S X=@GDATA@(2,I) D
.S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
.S X=$$TIUC(X) ; Check for control characters -emergency patch TIU*1.0*32
.I $L(X)=0 Q
.D HL7TXT^GMRCHL7P(.X,.HL,"\")
.S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_X
Q
;
AUTHDTTM ; Add Author and Date/Time to NTE
S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Author\R\\R\"_$G(@GDATA@(1202,"E"))
S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Datetime\R\\R\"_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))
S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Comment\R\\R\"
S NTECNT=4
Q
;
TIME(X,FMT) ; Copied from $$TIME^TIULS
; Receives X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
N HR,MIN,SEC,TIUI
I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
S X=$P(X,".",2),HR=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E("00",0,2-$L($E(X,5,6)))
F TIUI="HR","MIN","SEC" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
Q FMT
DATE(X,FMT) ; Copied from $$DATE^TIULS
; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
N AMTH,MM,CC,DD,YY,TIUI,TIUTMP
I +X'>0 S $P(TIUTMP," ",$L($G(FMT))+1)="",FMT=TIUTMP G QDATE
I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
F TIUI="AMTH","MM","DD","CC","YY" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
I FMT["HR" S FMT=$$TIME(X,FMT)
QDATE Q FMT
;
ACK ; Process ACK HL7 messages
N GMRCMSG,I,X,DONE,MSGID,ERRARY,ERRI
;Get the message
S ERRI=0
F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
. S GMRCMSG(I,1)=HLNODE
. S X=0 F S X=+$O(HLNODE(X)) Q:'X S GMRCMSG(I,(X+1))=HLNODE(X)
S DONE=0
S I=0 F S I=$O(GMRCMSG(I)) Q:'+I D Q:DONE
. I $P($G(GMRCMSG(I,1)),"|",1)="MSA" D Q
. . I $P($G(GMRCMSG(I,1)),"|",2)="AA" S DONE=1 Q
. . S MSGID=$P($G(GMRCMSG(I,1)),"|",3)
. I $P($G(GMRCMSG(I,1)),"|",1)="ERR" D
. . ;Process Error
. . S ERRI=ERRI+1
. . S ERRARY(ERRI,2)=$P($G(GMRCMSG(I,1)),"|",3)
. . I $P($G(GMRCMSG(I,1)),"|",6)'="" D Q
. . . S ERRARY(ERRI,3)=$P($P($G(GMRCMSG(I,1)),"|",6),"^",4)_"^"_$P($P($G(GMRCMSG(I,1)),"|",6),"^",5)
. . S ERRARY(ERRI,3)=$P($G(GMRCMSG(I,1)),"|",4)
I $D(ERRARY) D MESSAGE(MSGID,.ERRARY)
Q
MESSAGE(MSGID,ERRARY) ; Send a MailMan Message with the errors
N MSGTEXT,DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J
S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
S XMSUB="TIU CCRA Consults to HSRM HL7 Error"
S MSGTEXT(1)=" "
S MSGTEXT(2)="Error in transmitting HL7 message to HSRM"
S MSGTEXT(3)="Date: "_DATE
S MSGTEXT(4)="Message ID: "_MSGID
S MSGTEXT(5)="Error(s):"
S I=0,J=5 F S I=$O(ERRARY(I)) Q:'I D
. S J=J+1,MSGTEXT(J)=" "
. S J=J+1,MSGTEXT(J)=" "_$P($G(ERRARY(I,3)),U)_" - "_$P($G(ERRARY(I,3)),U,2)
. I $P($G(ERRARY(I,2)),U,1)'="" S J=J+1,MSGTEXT(J)=" Segment: "_$P($G(ERRARY(I,2)),U,1)
. I $P($G(ERRARY(I,2)),U,2)'="" S J=J+1,MSGTEXT(J)=" Sequence: "_$P($G(ERRARY(I,2)),U,2)
. I $P($G(ERRARY(I,2)),U,3)'="" S J=J+1,MSGTEXT(J)=" Field: "_$P($G(ERRARY(I,2)),U,3)
. I $P($G(ERRARY(I,2)),U,4)'="" S J=J+1,MSGTEXT(J)=" Fld Rep: "_$P($G(ERRARY(I,2)),U,4)
. I $P($G(ERRARY(I,2)),U,5)'="" S J=J+1,MSGTEXT(J)=" Component: "_$P($G(ERRARY(I,2)),U,5)
. I $P($G(ERRARY(I,2)),U,6)'="" S J=J+1,MSGTEXT(J)=" Sub-component: "_$P($G(ERRARY(I,2)),U,6)
S XMTEXT="MSGTEXT("
S XMDUZ="TIU-CCRA->HSRM Transaction Error"
S XMY("G.GMRC HCP HL7 MESSAGES")=""
D ^XMD
Q
TIUC(X) ; Check each segment of the TIU notes for HL7 control characters
Q:$G(X)=""
I $G(X)[$C(13,10,10) S X=$TR(X,$C(13,10,10),"") ; <cr><lf><lf>
I $G(X)[$C(13,10) S X=$TR(X,$C(13,10),"") ; <cr><lf>
I $G(X)[$C(13) S X=$TR(X,$C(13),"") ; TERM char
I $G(X)[$C(1) S X=$TR(X,$C(1),"") ; SOH
I $G(X)[$C(2) S X=$TR(X,$C(2),"") ; STX
I $G(X)[$C(3) S X=$TR(X,$C(3),"") ; ETX
I $G(X)[$C(4) S X=$TR(X,$C(4),"") ; EOT
I $G(X)[$C(5) S X=$TR(X,$C(5),"") ; ENQ
I $G(X)[$C(6) S X=$TR(X,$C(6),"") ; ACK
I $G(X)[$C(21) S X=$TR(X,$C(21),"") ; NAK
I $G(X)[$C(23) S X=$TR(X,$C(23),"") ; ETB
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRHL 13263 printed Jun 11, 2024@22:32:08 Page 2
TIUCCRHL ;LB/PB - Send TIU Notes MDM-T02 HL7 Message to CCRA/HSRM ;02/01/19 09:00
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**323,327,329**;Oct 24, 2019;Build 42
+2 ;This patch requires:
+3 ;four (4) CCRA TIU Historical Documents :
+4 ; 1 COMMUNITY CARE - PATIENT LETTER TITLE
+5 ; Std Title: NONVA PROGRESS NOTE
+6 ; 2 COMMUNITY CARE- ADMINISTRATIVE REQUEST TITLE
+7 ; Std Title: ADMINISTRATIVE NOTE
+8 ; 3 COMMUNITY CARE-COORDINATION NOTE TITLE
+9 ; Std Title: NONVA PROGRESS NOTE
+10 ; 4 COMMUNITY CARE-HOSPITAL NOTIFICATION NOTE TITLE
+11 ; Std Title: PRIMARY CARE ADMINISTRATIVE NOTE
+12 ;
+13 ;DBIA# Supported Reference
+14 ;----- --------------------------------
+15 ;2161 INIT^HLFNC2
+16 ;2164 GENERATE^HLMA
+17 ;3267 SSN^DPTLK1
+18 ;3630 BLDPID^VAFCQRY
+19 ;10103 FMTE^XLFDT, FMTHL7^XLFDT
+20 ;10104 UP^XLFSTR
+21 ;10106 FMDATE^HLFNC
+22 ;1252 OUTPTPR^SDUTL3
+23 ;6917 EN^VAFHLIN1
+24 ;10106 HLADDR^HLFNC
+25 ;2467 OR^ORX8
+26 ;2171 NS^XUAF4
+27 ;Fileman READ OF 8925:
+28 ; .01 DOCUMENT TYPE 0;1 Read w/Fileman
+29 ; .02 PATIENT 0;2 Read w/Fileman
+30 ; .03 VISIT 0;3 Read w/Fileman
+31 ; .04 PARENT DOCUMENT TYPE (P8925.1)
+32 ; .05 STATUS 0;5 Read w/Fileman
+33 ; .06 PARENT 0;6 Read w/Fileman
+34 ; .11 CREDIT STOP CODE ON 0;11 Read w/Fileman
+35 ; .07 EPISODE BEGIN DATE/T 0;7 Read w/Fileman
+36 ; .13 VISIT TYPE 0;13 Read w/Fileman
+37 ; 1202 AUTHOR/DICTATOR 12;2 Read w/Fileman
+38 ; 1204 EXPECTED SIGNER 12;4 Read w/Fileman
+39 ; 1208 EXPECTED COSIGNER 12;8 Read w/Fileman
+40 ; 1211 VISIT LOCATION 12;11 Read w/Fileman
+41 ; 1506 COSIGNER NEEDED 15;6 Read w/Fileman
+42 ; 1201 ENTRY DATE/TIME 12;1 Read w/Fileman
+43 ; 1301 REFERENCE DATE 13;1 Read w/Fileman
+44 ; GLOBAL REFERENCE:
+45 ; ^TIU(8925,'AAU'
+46 ; GLOBAL REFERENCE:
+47 ; ^TIU(8925,'ASUP'
+48 ; GLOBAL REFERENCE:
+49 ; ^TIU(8925,'APT'
+50 ; GLOBAL REFERENCE:
+51 ; ^TIU(8925,'ACLPT'
+52 ;==============================================================
+53 QUIT
+54 ;
EN() ;Entry point to routine called from POSTSIGN^TIULC1 for the CCRA TIU Documents - Historical
+1 ;Expects the context has defined: DFN (Patient IEN -^DPT(), DA (TIU document ID:^TIU(8925,DA)
+2 ;
+3 NEW I,GMRCDA,GMRCM,STATUS,POSTSIGC,PARDOCTY,OK,TIUTYP
+4 ;SET HL7 VARIABLES
+5 NEW FS,CS,RS,ES,SS,MID,HLQUIT,HLNODE
+6 NEW MSG,HDR,SEG,SEGTYPE,MSGARY,LASTSEG,HDRTIME,ABORT,BASEDT,CLINARY,COUNT,PROVDTL
+7 ;
+8 IF +$GET(DA)'>0
SET ^TMP("TIUHL7CCRA",$JOB,"ERR NO TIU Document IEN("_DA_") passed from CPRS")=""
QUIT
+9 ;Patch 329 fix thE undefined DFN, occuring when the user comes back in CPRS
+10 ;and signs a previously saved and unsigned note
+11 IF $GET(DFN)=""
Begin DoDot:1
+12 SET DFN=$PIECE($GET(^TIU(8925,+DA,0)),"^",2)
+13 IF $GET(DFN)=""
SET ^TMP("TIUHL7CCRA",$JOB,"ERR NO TIU Document IEN("_DA_") passed from CPRS")=""
QUIT
End DoDot:1
+14 ;
+15 NEW SNAME,GMRCHL,ZERR,ZCNT,ECH,DATA,GDATA,URG,TYP,RES,EFFDT,PDUZ,PN,ADDR,PH,GMRCP,SENS,DX,DXCODE
+16 NEW PCP,PCDUZ,PCPN,PCADDR,PCPH
+17 SET SNAME="TIU CCRA-HSRM MDM-T02 SERVER"
+18 SET GMRCHL("EID")=$$FIND1^DIC(101,,"X",SNAME)
+19 if 'GMRCHL("EID")
QUIT
DO INIT^HLFNC2(GMRCHL("EID"),.GMRCHL)
+20 ;component separator
SET ZERR=""
SET ZCNT=0
SET ECH=$EXTRACT(GMRCHL("ECH"))
+21 SET FS=$GET(GMRCHL("FS"),"|")
+22 SET CS=$EXTRACT($GET(GMRCHL("ECH")),1)
if CS=""
SET CS="^"
+23 SET RS=$EXTRACT($GET(GMRCHL("ECH")),2)
if RS=""
SET RS="~"
+24 SET ES=$EXTRACT($GET(GMRCHL("ECH")),3)
if ES=""
SET ES="\"
+25 SET SS=$EXTRACT($GET(GMRCHL("ECH")),4)
if SS=""
SET SS="&"
+26 SET MID=$GET(GMRCHL("MID"))
+27 SET (HLQUIT,HLNODE)=0
+28 ;
+29 SET GMRCDA=$GET(DA)
+30 SET POSTSIGC=""
+31 ;Check if document DA passed in has Addenda, and retrieve the most recent one
+32 IF $DATA(^TIU(8925,"DAD",$GET(DA)))=10
SET GMRCDA=+$ORDER(^TIU(8925,"DAD",$GET(DA),99999999),-1)
+33 ;
+34 ;get TIU Note data in ^TMP
+35 SET DATA=$NAME(^TMP("TIUHL7CCRA",$JOB))
KILL @DATA
+36 ;file,record,field,parm,targetarray,errortargetarray,internal
+37 DO GETS^DIQ(8925,GMRCDA,"*","IE",DATA)
+38 ;File 8925 data IN ^TMP
+39 SET GDATA=$NAME(^TMP("TIUHL7CCRA",$JOB,8925,+GMRCDA_","))
+40 ;Patch TIU*1*329 fix <undefined> When User picks up an unsigned note from another CPRS session-
+41 ;I DFN'=$G(@GDATA@(.02,"I")) S ^TMP("TIUHL7CCRA",$J,"ERR: CPRS Patient DFN :"_DFN_" doesn't match Document Patient DFN: "_$G(@GDATA@(.02,"I")))="" Q
+42 IF $GET(DFN)'=$GET(@GDATA@(.02,"I"))
SET ^TMP("TIUHL7CCRA",$JOB,"ERR: CPRS Patient DFN :"_$GET(DFN)_" doesn't match Document Patient DFN: "_$GET(@GDATA@(.02,"I")))=""
QUIT
+43 ;check if addendum DA is passed in and check if it is for Community
+44 SET TIUTYP=$GET(@GDATA@(.01,"E"))
+45 SET OK=1
+46 IF TIUTYP="ADDENDUM"
Begin DoDot:1
+47 ;check if parent title has the POST-SIGNATURE CODE
+48 SET PARDOCTY=+$GET(^TIU(8925,$GET(DA),0))
+49 IF +$GET(PARDOCTY)<=0
SET OK=0
+50 SET POSTSIGC=$$GET1^DIQ(8925.1,PARDOCTY_",",4.9)
+51 IF POSTSIGC'["TIUCCRHL"
SET OK=0
SET ^TMP("TIUHL7CCRA",$JOB,"ERR: TIU ADDENDA IS NOT SETUP TO SEND MHM-T02:"_POSTSIGC)=""
+52 IF $GET(@GDATA@(.05,"E"))'="COMPLETED"
SET OK=0
SET ^TMP("TIUHL7CCRA",$JOB,"ERR: TIU ADDENDA STATUS IS NOT COMPLETED:"_$GET(@GDATA@(.05,"E")))=""
End DoDot:1
+53 ;QUIT if addendum and original note does not have the CCRA HL7 trigger code
IF OK<1
QUIT
+54 ;
+55 ;start creating the segments.
+56 ;EVN Segment
+57 ; EVN 1-Event Type Code: "T02"
+58 ; EVN 3-Recorded Date/Time: 1201 ENTRY DATE/TIME
+59 ; EVN 4-Event Reason: can use "O"-Other / "02"-Physician/health practitioner order
+60 ; EVN 5-Operator ID: 1202 AUTHOR/DICTATOR IEN(+DUZ)
+61 ; EVN 6-Event Occurred: 1301 REFERENCE DATE
+62 ; EVN 7-Event Facility: 1211 VISIT LOCATION (P44)
+63 ;
+64 SET ZCNT=ZCNT+1
+65 SET GMRCM(ZCNT)="EVN"_FS_"T02"_FS_FS_$$FMTHL7^XLFDT($GET(@GDATA@(1201,"I")))_FS_"O"_FS_$GET(@GDATA@(1202,"I"))
+66 SET GMRCM(ZCNT)=GMRCM(ZCNT)_FS_$$FMTHL7^XLFDT($GET(@GDATA@(1301,"I")))_FS_$GET(@GDATA@(1211,"I"))_CS_$GET(@GDATA@(1211,"E"))
+67 ;
+68 ;PID segment - May be multiple nodes in the return array - make nodes 2-n sub nodes
+69 SET DFN=$GET(@GDATA@(.02,"I"))
SET ZERR=""
+70 DO BLDPID^VAFCQRY(DFN,1,"ALL",.GMRCP,.GMRCHL,ZERR)
+71 SET I=0
FOR
SET I=$ORDER(GMRCP(I))
if 'I
QUIT
Begin DoDot:1
+72 IF I=1
SET ZCNT=ZCNT+1
SET GMRCM(ZCNT)=$TRANSLATE(GMRCP(I),"""")
QUIT
+73 SET GMRCM(ZCNT,I)=$TRANSLATE(GMRCP(I),"""")
End DoDot:1
+74 KILL GMRCP
+75 ;
+76 ;PV1 segment
+77 ;VAIP(18)=Attending Physician, VAIP(13,5)=Primary Physician for admission
DO IN5^VADPT
+78 SET ZCNT=ZCNT+1
SET GMRCM(ZCNT)="PV1"_FS_"1"_FS_$SELECT(VAIP(13):"I",1:"O")_FS_FS_FS_FS_FS_VAIP(18)_FS
+79 ;location for last movement event
IF VAIP(5)
SET $PIECE(GMRCM(ZCNT),FS,4)=VAIP(5)
+80 NEW GMRCDIV
+81 ; add in division value
SET GMRCDIV=$$NS^XUAF4(DUZ(2))
SET GMRCDIV=$PIECE(GMRCDIV,CS,2)
+82 NEW A,B
SET A=SS_GMRCDIV
SET B=$PIECE(GMRCM(ZCNT),FS,4)
SET $PIECE(B,CS,4)=A
SET $PIECE(GMRCM(ZCNT),FS,4)=B
KILL A,B
+83 KILL GMRCDIV
+84 ;
+85 ;sensitive patient
SET SENS=$$SSN^DPTLK1(DFN)
IF SENS["*SENSITIVE*"
SET $PIECE(GMRCM(ZCNT),FS,17)="R"
+86 SET $PIECE(GMRCM(ZCNT),FS,18)=VAIP(13,5)
+87 KILL VAIP
+88 DO KVA^VADPT
+89 ;
+90 ;TXA segment
+91 ; TXA.1 Set ID - TXA: "1"
+92 ; TXA.2 Document Type: .01 DOCUMENT TYPE
+93 ; TXA.4 Activity Date/Time: 1301 REFERENCE DATE
+94 ; TXA.8 Edit Date/Time: 1201 ENTRY DATE/TIME
+95 ; TXA.12 Unique Document Number: GMRCDA TIU note IEN
+96 ; TXA.13 Parent Document Number: GMRCDA/DA TIU note/ADDENDUM IEN
+97 ; TXA.16 Unique Document File Name: ADDENDUM Parent Document Title
+98 ; XA.17 Document Completion Status: .05 STATUS
+99 SET ZCNT=ZCNT+1
+100 SET GMRCM(ZCNT)="TXA"_FS_"1"_FS_$GET(@GDATA@(.01,"E"))_FS_FS_$$FMTHL7^XLFDT($GET(@GDATA@(1301,"I")))_FS_FS_FS_FS_$$FMTHL7^XLFDT($GET(@GDATA@(1201,"I")))
+101 SET GMRCM(ZCNT)=GMRCM(ZCNT)_FS_FS_FS_FS_GMRCDA_FS_$GET(@GDATA@(.06,"I"))_FS_FS_FS_$GET(@GDATA@(.06,"E"))_FS_$GET(@GDATA@(.05,"E"))
+102 ;
+103 ;OBX segment
+104 ; OBX.1-Set ID: 1
+105 ; OBX.2-Value Type: "TX"
+106 ; OBX.3-Observation Identifier:TIU note IEN (GMRCDA)
+107 ; OBX.11-Observation result status codes interpretation: F (Final results)
+108 ; OBX.14-Date/Time of the Observation: 1201 -TIU ENTRY DATE/TIME
+109 ; OBX.16-ResponsibleObserver() : 1204 EXPECTED SIGNER /1208 EXPECTED COSIGNER
+110 NEW PRSIG1,PRSIG2
+111 SET ZCNT=ZCNT+1
+112 SET GMRCM(ZCNT)="OBX"_FS_"1"_FS_"TX"_FS_GMRCDA_FS_FS_FS_FS_FS_FS_FS_FS_"F"_FS_FS_FS_$$FMTHL7^XLFDT($GET(@GDATA@(1201,"I")))
+113 SET GMRCM(ZCNT)=GMRCM(ZCNT)_FS_FS_$PIECE($GET(@GDATA@(1204,"E")),",",1)_CS_$PIECE($GET(@GDATA@(1204,"E")),",",2)
+114 SET GMRCM(ZCNT)=GMRCM(ZCNT)_SS_$PIECE($GET(@GDATA@(1208,"E")),",",1)_CS_$PIECE($GET(@GDATA@(1208,"E")),",",2)
+115 ;
+116 ;NTE segment
+117 DO NTE(.GMRCHL)
+118 ;
+119 ;Send HL7 Message
+120 NEW HL,HLA,GMRCRES,GMRCHLP
+121 MERGE HL=GMRCHL,HLA("HLS")=GMRCM
+122 MERGE GMRCHL=^XTMP("TIUHL7CCRA","MESSAGE")
+123 DO GENERATE^HLMA(GMRCHL("EID"),"LM",1,.GMRCRES,"",.GMRCHLP)
+124 KILL ^TMP("TIUHL7CCRA",$JOB)
+125 QUIT
NTE(HL) ; Find TIU and build NTE segments
+1 NEW NTECNT,X
SET NTECNT=1
+2 DO AUTHDTTM
+3 ; Build NTE for CM^ADDENDED
+4 NEW GMRCCMP
+5 SET GMRCCMP=""
+6 SET ZCNT=ZCNT+1
SET GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_"P"_FS_"Progress Note:"_$GET(@GDATA@(.01,"E"))
+7 ;check if Document Type is ADDENDUM
+8 SET TIUTYP=$GET(@GDATA@(.01,"E"))
+9 IF TIUTYP="ADDENDUM"
Begin DoDot:1
+10 SET GMRCCMP=$$DATE^GMRCCCRA($GET(@GDATA@(1301,"I")),"MM/DD/CCYY")_" ADDENDUM"_" STATUS: "_$$GET1^DIQ(8925,+GMRCDA_",",.05)
End DoDot:1
+11 SET I=0
+12 FOR
SET I=$ORDER(@GDATA@(2,I))
if +I=0
QUIT
SET X=@GDATA@(2,I)
Begin DoDot:1
+13 SET X=$$TRIM^XLFSTR(X)
IF $LENGTH(X)=0
QUIT
+14 ; Check for control characters -emergency patch TIU*1.0*32
SET X=$$TIUC(X)
+15 IF $LENGTH(X)=0
QUIT
+16 DO HL7TXT^GMRCHL7P(.X,.HL,"\")
+17 SET ZCNT=ZCNT+1
SET NTECNT=NTECNT+1
SET GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_X
End DoDot:1
+18 QUIT
+19 ;
AUTHDTTM ; Add Author and Date/Time to NTE
+1 SET ZCNT=ZCNT+1
SET GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Author\R\\R\"_$GET(@GDATA@(1202,"E"))
+2 SET ZCNT=ZCNT+1
SET NTECNT=NTECNT+1
SET GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Datetime\R\\R\"_$$FMTHL7^XLFDT($GET(@GDATA@(1201,"I")))
+3 SET ZCNT=ZCNT+1
SET NTECNT=NTECNT+1
SET GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Comment\R\\R\"
+4 SET NTECNT=4
+5 QUIT
+6 ;
TIME(X,FMT) ; Copied from $$TIME^TIULS
+1 ; Receives X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
+2 NEW HR,MIN,SEC,TIUI
+3 IF $SELECT('$DATA(FMT):1,'$LENGTH(FMT):1,1:0)
SET FMT="HR:MIN"
+4 SET X=$PIECE(X,".",2)
SET HR=$EXTRACT(X,1,2)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,1,2)))
SET MIN=$EXTRACT(X,3,4)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,3,4)))
SET SEC=$EXTRACT(X,5,6)_$EXTRACT("00",0,2-$LENGTH($EXTRACT(X,5,6)))
+5 FOR TIUI="HR","MIN","SEC"
if FMT[TIUI
SET FMT=$PIECE(FMT,TIUI)_@TIUI_$PIECE(FMT,TIUI,2)
+6 QUIT FMT
DATE(X,FMT) ; Copied from $$DATE^TIULS
+1 ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
+2 NEW AMTH,MM,CC,DD,YY,TIUI,TIUTMP
+3 IF +X'>0
SET $PIECE(TIUTMP," ",$LENGTH($GET(FMT))+1)=""
SET FMT=TIUTMP
GOTO QDATE
+4 IF $SELECT('$DATA(FMT):1,'$LENGTH(FMT):1,1:0)
SET FMT="MM/DD/YY"
+5 SET MM=$EXTRACT(X,4,5)
SET DD=$EXTRACT(X,6,7)
SET YY=$EXTRACT(X,2,3)
SET CC=17+$EXTRACT(X)
+6 if FMT["AMTH"
SET AMTH=$PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
+7 FOR TIUI="AMTH","MM","DD","CC","YY"
if FMT[TIUI
SET FMT=$PIECE(FMT,TIUI)_@TIUI_$PIECE(FMT,TIUI,2)
+8 IF FMT["HR"
SET FMT=$$TIME(X,FMT)
QDATE QUIT FMT
+1 ;
ACK ; Process ACK HL7 messages
+1 NEW GMRCMSG,I,X,DONE,MSGID,ERRARY,ERRI
+2 ;Get the message
+3 SET ERRI=0
+4 FOR I=1:1
XECUTE HLNEXT
if (HLQUIT'>0)
QUIT
Begin DoDot:1
+5 SET GMRCMSG(I,1)=HLNODE
+6 SET X=0
FOR
SET X=+$ORDER(HLNODE(X))
if 'X
QUIT
SET GMRCMSG(I,(X+1))=HLNODE(X)
End DoDot:1
+7 SET DONE=0
+8 SET I=0
FOR
SET I=$ORDER(GMRCMSG(I))
if '+I
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(GMRCMSG(I,1)),"|",1)="MSA"
Begin DoDot:2
+10 IF $PIECE($GET(GMRCMSG(I,1)),"|",2)="AA"
SET DONE=1
QUIT
+11 SET MSGID=$PIECE($GET(GMRCMSG(I,1)),"|",3)
End DoDot:2
QUIT
+12 IF $PIECE($GET(GMRCMSG(I,1)),"|",1)="ERR"
Begin DoDot:2
+13 ;Process Error
+14 SET ERRI=ERRI+1
+15 SET ERRARY(ERRI,2)=$PIECE($GET(GMRCMSG(I,1)),"|",3)
+16 IF $PIECE($GET(GMRCMSG(I,1)),"|",6)'=""
Begin DoDot:3
+17 SET ERRARY(ERRI,3)=$PIECE($PIECE($GET(GMRCMSG(I,1)),"|",6),"^",4)_"^"_$PIECE($PIECE($GET(GMRCMSG(I,1)),"|",6),"^",5)
End DoDot:3
QUIT
+18 SET ERRARY(ERRI,3)=$PIECE($GET(GMRCMSG(I,1)),"|",4)
End DoDot:2
End DoDot:1
if DONE
QUIT
+19 IF $DATA(ERRARY)
DO MESSAGE(MSGID,.ERRARY)
+20 QUIT
MESSAGE(MSGID,ERRARY) ; Send a MailMan Message with the errors
+1 NEW MSGTEXT,DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J
+2 SET DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($PIECE(HL("DTM"),"-",1)))
+3 SET XMSUB="TIU CCRA Consults to HSRM HL7 Error"
+4 SET MSGTEXT(1)=" "
+5 SET MSGTEXT(2)="Error in transmitting HL7 message to HSRM"
+6 SET MSGTEXT(3)="Date: "_DATE
+7 SET MSGTEXT(4)="Message ID: "_MSGID
+8 SET MSGTEXT(5)="Error(s):"
+9 SET I=0
SET J=5
FOR
SET I=$ORDER(ERRARY(I))
if 'I
QUIT
Begin DoDot:1
+10 SET J=J+1
SET MSGTEXT(J)=" "
+11 SET J=J+1
SET MSGTEXT(J)=" "_$PIECE($GET(ERRARY(I,3)),U)_" - "_$PIECE($GET(ERRARY(I,3)),U,2)
+12 IF $PIECE($GET(ERRARY(I,2)),U,1)'=""
SET J=J+1
SET MSGTEXT(J)=" Segment: "_$PIECE($GET(ERRARY(I,2)),U,1)
+13 IF $PIECE($GET(ERRARY(I,2)),U,2)'=""
SET J=J+1
SET MSGTEXT(J)=" Sequence: "_$PIECE($GET(ERRARY(I,2)),U,2)
+14 IF $PIECE($GET(ERRARY(I,2)),U,3)'=""
SET J=J+1
SET MSGTEXT(J)=" Field: "_$PIECE($GET(ERRARY(I,2)),U,3)
+15 IF $PIECE($GET(ERRARY(I,2)),U,4)'=""
SET J=J+1
SET MSGTEXT(J)=" Fld Rep: "_$PIECE($GET(ERRARY(I,2)),U,4)
+16 IF $PIECE($GET(ERRARY(I,2)),U,5)'=""
SET J=J+1
SET MSGTEXT(J)=" Component: "_$PIECE($GET(ERRARY(I,2)),U,5)
+17 IF $PIECE($GET(ERRARY(I,2)),U,6)'=""
SET J=J+1
SET MSGTEXT(J)=" Sub-component: "_$PIECE($GET(ERRARY(I,2)),U,6)
End DoDot:1
+18 SET XMTEXT="MSGTEXT("
+19 SET XMDUZ="TIU-CCRA->HSRM Transaction Error"
+20 SET XMY("G.GMRC HCP HL7 MESSAGES")=""
+21 DO ^XMD
+22 QUIT
TIUC(X) ; Check each segment of the TIU notes for HL7 control characters
+1 if $GET(X)=""
QUIT
+2 ; <cr><lf><lf>
IF $GET(X)[$CHAR(13,10,10)
SET X=$TRANSLATE(X,$CHAR(13,10,10),"")
+3 ; <cr><lf>
IF $GET(X)[$CHAR(13,10)
SET X=$TRANSLATE(X,$CHAR(13,10),"")
+4 ; TERM char
IF $GET(X)[$CHAR(13)
SET X=$TRANSLATE(X,$CHAR(13),"")
+5 ; SOH
IF $GET(X)[$CHAR(1)
SET X=$TRANSLATE(X,$CHAR(1),"")
+6 ; STX
IF $GET(X)[$CHAR(2)
SET X=$TRANSLATE(X,$CHAR(2),"")
+7 ; ETX
IF $GET(X)[$CHAR(3)
SET X=$TRANSLATE(X,$CHAR(3),"")
+8 ; EOT
IF $GET(X)[$CHAR(4)
SET X=$TRANSLATE(X,$CHAR(4),"")
+9 ; ENQ
IF $GET(X)[$CHAR(5)
SET X=$TRANSLATE(X,$CHAR(5),"")
+10 ; ACK
IF $GET(X)[$CHAR(6)
SET X=$TRANSLATE(X,$CHAR(6),"")
+11 ; NAK
IF $GET(X)[$CHAR(21)
SET X=$TRANSLATE(X,$CHAR(21),"")
+12 ; ETB
IF $GET(X)[$CHAR(23)
SET X=$TRANSLATE(X,$CHAR(23),"")
+13 QUIT X
