Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUCCRHL

TIUCCRHL.m

Go to the documentation of this file.
  1. 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
  1. ;This patch requires:
  1. ;four (4) CCRA TIU Historical Documents :
  1. ; 1 COMMUNITY CARE - PATIENT LETTER TITLE
  1. ; Std Title: NONVA PROGRESS NOTE
  1. ; 2 COMMUNITY CARE- ADMINISTRATIVE REQUEST TITLE
  1. ; Std Title: ADMINISTRATIVE NOTE
  1. ; 3 COMMUNITY CARE-COORDINATION NOTE TITLE
  1. ; Std Title: NONVA PROGRESS NOTE
  1. ; 4 COMMUNITY CARE-HOSPITAL NOTIFICATION NOTE TITLE
  1. ; Std Title: PRIMARY CARE ADMINISTRATIVE NOTE
  1. ;
  1. ;DBIA# Supported Reference
  1. ;----- --------------------------------
  1. ;2161 INIT^HLFNC2
  1. ;2164 GENERATE^HLMA
  1. ;3267 SSN^DPTLK1
  1. ;3630 BLDPID^VAFCQRY
  1. ;10103 FMTE^XLFDT, FMTHL7^XLFDT
  1. ;10104 UP^XLFSTR
  1. ;10106 FMDATE^HLFNC
  1. ;1252 OUTPTPR^SDUTL3
  1. ;6917 EN^VAFHLIN1
  1. ;10106 HLADDR^HLFNC
  1. ;2467 OR^ORX8
  1. ;2171 NS^XUAF4
  1. ;Fileman READ OF 8925:
  1. ; .01 DOCUMENT TYPE 0;1 Read w/Fileman
  1. ; .02 PATIENT 0;2 Read w/Fileman
  1. ; .03 VISIT 0;3 Read w/Fileman
  1. ; .04 PARENT DOCUMENT TYPE (P8925.1)
  1. ; .05 STATUS 0;5 Read w/Fileman
  1. ; .06 PARENT 0;6 Read w/Fileman
  1. ; .11 CREDIT STOP CODE ON 0;11 Read w/Fileman
  1. ; .07 EPISODE BEGIN DATE/T 0;7 Read w/Fileman
  1. ; .13 VISIT TYPE 0;13 Read w/Fileman
  1. ; 1202 AUTHOR/DICTATOR 12;2 Read w/Fileman
  1. ; 1204 EXPECTED SIGNER 12;4 Read w/Fileman
  1. ; 1208 EXPECTED COSIGNER 12;8 Read w/Fileman
  1. ; 1211 VISIT LOCATION 12;11 Read w/Fileman
  1. ; 1506 COSIGNER NEEDED 15;6 Read w/Fileman
  1. ; 1201 ENTRY DATE/TIME 12;1 Read w/Fileman
  1. ; 1301 REFERENCE DATE 13;1 Read w/Fileman
  1. ; GLOBAL REFERENCE:
  1. ; ^TIU(8925,'AAU'
  1. ; GLOBAL REFERENCE:
  1. ; ^TIU(8925,'ASUP'
  1. ; GLOBAL REFERENCE:
  1. ; ^TIU(8925,'APT'
  1. ; GLOBAL REFERENCE:
  1. ; ^TIU(8925,'ACLPT'
  1. ;==============================================================
  1. Q
  1. ;
  1. 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)
  1. ;
  1. N I,GMRCDA,GMRCM,STATUS,POSTSIGC,PARDOCTY,OK,TIUTYP
  1. ;SET HL7 VARIABLES
  1. N FS,CS,RS,ES,SS,MID,HLQUIT,HLNODE
  1. N MSG,HDR,SEG,SEGTYPE,MSGARY,LASTSEG,HDRTIME,ABORT,BASEDT,CLINARY,COUNT,PROVDTL
  1. ;
  1. I +$G(DA)'>0 S ^TMP("TIUHL7CCRA",$J,"ERR NO TIU Document IEN("_DA_") passed from CPRS")="" Q
  1. ;Patch 329 fix thE undefined DFN, occuring when the user comes back in CPRS
  1. ;and signs a previously saved and unsigned note
  1. I $G(DFN)="" D
  1. . S DFN=$P($G(^TIU(8925,+DA,0)),"^",2)
  1. . I $G(DFN)="" S ^TMP("TIUHL7CCRA",$J,"ERR NO TIU Document IEN("_DA_") passed from CPRS")="" Q
  1. ;
  1. N SNAME,GMRCHL,ZERR,ZCNT,ECH,DATA,GDATA,URG,TYP,RES,EFFDT,PDUZ,PN,ADDR,PH,GMRCP,SENS,DX,DXCODE
  1. N PCP,PCDUZ,PCPN,PCADDR,PCPH
  1. S SNAME="TIU CCRA-HSRM MDM-T02 SERVER"
  1. S GMRCHL("EID")=$$FIND1^DIC(101,,"X",SNAME)
  1. Q:'GMRCHL("EID") D INIT^HLFNC2(GMRCHL("EID"),.GMRCHL)
  1. S ZERR="",ZCNT=0,ECH=$E(GMRCHL("ECH")) ;component separator
  1. S FS=$G(GMRCHL("FS"),"|")
  1. S CS=$E($G(GMRCHL("ECH")),1) S:CS="" CS="^"
  1. S RS=$E($G(GMRCHL("ECH")),2) S:RS="" RS="~"
  1. S ES=$E($G(GMRCHL("ECH")),3) S:ES="" ES="\"
  1. S SS=$E($G(GMRCHL("ECH")),4) S:SS="" SS="&"
  1. S MID=$G(GMRCHL("MID"))
  1. S (HLQUIT,HLNODE)=0
  1. ;
  1. S GMRCDA=$G(DA)
  1. S POSTSIGC=""
  1. ;Check if document DA passed in has Addenda, and retrieve the most recent one
  1. I $D(^TIU(8925,"DAD",$G(DA)))=10 S GMRCDA=+$O(^TIU(8925,"DAD",$G(DA),99999999),-1)
  1. ;
  1. ;get TIU Note data in ^TMP
  1. S DATA=$NA(^TMP("TIUHL7CCRA",$J)) K @DATA
  1. ;file,record,field,parm,targetarray,errortargetarray,internal
  1. D GETS^DIQ(8925,GMRCDA,"*","IE",DATA)
  1. ;File 8925 data IN ^TMP
  1. S GDATA=$NA(^TMP("TIUHL7CCRA",$J,8925,+GMRCDA_","))
  1. ;Patch TIU*1*329 fix <undefined> When User picks up an unsigned note from another CPRS session-
  1. ;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
  1. 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
  1. ;check if addendum DA is passed in and check if it is for Community
  1. S TIUTYP=$G(@GDATA@(.01,"E"))
  1. S OK=1
  1. I TIUTYP="ADDENDUM" D
  1. . ;check if parent title has the POST-SIGNATURE CODE
  1. . S PARDOCTY=+$G(^TIU(8925,$G(DA),0))
  1. . I +$G(PARDOCTY)<=0 S OK=0
  1. . S POSTSIGC=$$GET1^DIQ(8925.1,PARDOCTY_",",4.9)
  1. . I POSTSIGC'["TIUCCRHL" S OK=0 S ^TMP("TIUHL7CCRA",$J,"ERR: TIU ADDENDA IS NOT SETUP TO SEND MHM-T02:"_POSTSIGC)=""
  1. . I $G(@GDATA@(.05,"E"))'="COMPLETED" S OK=0 S ^TMP("TIUHL7CCRA",$J,"ERR: TIU ADDENDA STATUS IS NOT COMPLETED:"_$G(@GDATA@(.05,"E")))=""
  1. I OK<1 Q ;QUIT if addendum and original note does not have the CCRA HL7 trigger code
  1. ;
  1. ;start creating the segments.
  1. ;EVN Segment
  1. ; EVN 1-Event Type Code: "T02"
  1. ; EVN 3-Recorded Date/Time: 1201 ENTRY DATE/TIME
  1. ; EVN 4-Event Reason: can use "O"-Other / "02"-Physician/health practitioner order
  1. ; EVN 5-Operator ID: 1202 AUTHOR/DICTATOR IEN(+DUZ)
  1. ; EVN 6-Event Occurred: 1301 REFERENCE DATE
  1. ; EVN 7-Event Facility: 1211 VISIT LOCATION (P44)
  1. ;
  1. S ZCNT=ZCNT+1
  1. S GMRCM(ZCNT)="EVN"_FS_"T02"_FS_FS_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))_FS_"O"_FS_$G(@GDATA@(1202,"I"))
  1. S GMRCM(ZCNT)=GMRCM(ZCNT)_FS_$$FMTHL7^XLFDT($G(@GDATA@(1301,"I")))_FS_$G(@GDATA@(1211,"I"))_CS_$G(@GDATA@(1211,"E"))
  1. ;
  1. ;PID segment - May be multiple nodes in the return array - make nodes 2-n sub nodes
  1. S DFN=$G(@GDATA@(.02,"I")),ZERR=""
  1. D BLDPID^VAFCQRY(DFN,1,"ALL",.GMRCP,.GMRCHL,ZERR)
  1. S I=0 F S I=$O(GMRCP(I)) Q:'I D
  1. .I I=1 S ZCNT=ZCNT+1,GMRCM(ZCNT)=$TR(GMRCP(I),"""") Q
  1. .S GMRCM(ZCNT,I)=$TR(GMRCP(I),"""")
  1. K GMRCP
  1. ;
  1. ;PV1 segment
  1. D IN5^VADPT ;VAIP(18)=Attending Physician, VAIP(13,5)=Primary Physician for admission
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="PV1"_FS_"1"_FS_$S(VAIP(13):"I",1:"O")_FS_FS_FS_FS_FS_VAIP(18)_FS
  1. I VAIP(5) S $P(GMRCM(ZCNT),FS,4)=VAIP(5) ;location for last movement event
  1. N GMRCDIV
  1. S GMRCDIV=$$NS^XUAF4(DUZ(2)),GMRCDIV=$P(GMRCDIV,CS,2) ; add in division value
  1. 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
  1. K GMRCDIV
  1. ;
  1. S SENS=$$SSN^DPTLK1(DFN) I SENS["*SENSITIVE*" S $P(GMRCM(ZCNT),FS,17)="R" ;sensitive patient
  1. S $P(GMRCM(ZCNT),FS,18)=VAIP(13,5)
  1. K VAIP
  1. D KVA^VADPT
  1. ;
  1. ;TXA segment
  1. ; TXA.1 Set ID - TXA: "1"
  1. ; TXA.2 Document Type: .01 DOCUMENT TYPE
  1. ; TXA.4 Activity Date/Time: 1301 REFERENCE DATE
  1. ; TXA.8 Edit Date/Time: 1201 ENTRY DATE/TIME
  1. ; TXA.12 Unique Document Number: GMRCDA TIU note IEN
  1. ; TXA.13 Parent Document Number: GMRCDA/DA TIU note/ADDENDUM IEN
  1. ; TXA.16 Unique Document File Name: ADDENDUM Parent Document Title
  1. ; XA.17 Document Completion Status: .05 STATUS
  1. S ZCNT=ZCNT+1
  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")))
  1. 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"))
  1. ;
  1. ;OBX segment
  1. ; OBX.1-Set ID: 1
  1. ; OBX.2-Value Type: "TX"
  1. ; OBX.3-Observation Identifier:TIU note IEN (GMRCDA)
  1. ; OBX.11-Observation result status codes interpretation: F (Final results)
  1. ; OBX.14-Date/Time of the Observation: 1201 -TIU ENTRY DATE/TIME
  1. ; OBX.16-ResponsibleObserver() : 1204 EXPECTED SIGNER /1208 EXPECTED COSIGNER
  1. N PRSIG1,PRSIG2
  1. S ZCNT=ZCNT+1
  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")))
  1. S GMRCM(ZCNT)=GMRCM(ZCNT)_FS_FS_$P($G(@GDATA@(1204,"E")),",",1)_CS_$P($G(@GDATA@(1204,"E")),",",2)
  1. S GMRCM(ZCNT)=GMRCM(ZCNT)_SS_$P($G(@GDATA@(1208,"E")),",",1)_CS_$P($G(@GDATA@(1208,"E")),",",2)
  1. ;
  1. ;NTE segment
  1. D NTE(.GMRCHL)
  1. ;
  1. ;Send HL7 Message
  1. N HL,HLA,GMRCRES,GMRCHLP
  1. M HL=GMRCHL,HLA("HLS")=GMRCM
  1. M GMRCHL=^XTMP("TIUHL7CCRA","MESSAGE")
  1. D GENERATE^HLMA(GMRCHL("EID"),"LM",1,.GMRCRES,"",.GMRCHLP)
  1. K ^TMP("TIUHL7CCRA",$J)
  1. Q
  1. NTE(HL) ; Find TIU and build NTE segments
  1. N NTECNT,X S NTECNT=1
  1. D AUTHDTTM
  1. ; Build NTE for CM^ADDENDED
  1. N GMRCCMP
  1. S GMRCCMP=""
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_"P"_FS_"Progress Note:"_$G(@GDATA@(.01,"E"))
  1. ;check if Document Type is ADDENDUM
  1. S TIUTYP=$G(@GDATA@(.01,"E"))
  1. I TIUTYP="ADDENDUM" D
  1. . S GMRCCMP=$$DATE^GMRCCCRA($G(@GDATA@(1301,"I")),"MM/DD/CCYY")_" ADDENDUM"_" STATUS: "_$$GET1^DIQ(8925,+GMRCDA_",",.05)
  1. S I=0
  1. F S I=$O(@GDATA@(2,I)) Q:+I=0 S X=@GDATA@(2,I) D
  1. .S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
  1. .S X=$$TIUC(X) ; Check for control characters -emergency patch TIU*1.0*32
  1. .I $L(X)=0 Q
  1. .D HL7TXT^GMRCHL7P(.X,.HL,"\")
  1. .S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_X
  1. Q
  1. ;
  1. AUTHDTTM ; Add Author and Date/Time to NTE
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Author\R\\R\"_$G(@GDATA@(1202,"E"))
  1. S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Datetime\R\\R\"_$$FMTHL7^XLFDT($G(@GDATA@(1201,"I")))
  1. S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE"_FS_NTECNT_FS_FS_"Comment\R\\R\"
  1. S NTECNT=4
  1. Q
  1. ;
  1. TIME(X,FMT) ; Copied from $$TIME^TIULS
  1. ; Receives X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
  1. N HR,MIN,SEC,TIUI
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
  1. 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)))
  1. F TIUI="HR","MIN","SEC" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
  1. Q FMT
  1. DATE(X,FMT) ; Copied from $$DATE^TIULS
  1. ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
  1. N AMTH,MM,CC,DD,YY,TIUI,TIUTMP
  1. I +X'>0 S $P(TIUTMP," ",$L($G(FMT))+1)="",FMT=TIUTMP G QDATE
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
  1. S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
  1. S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
  1. F TIUI="AMTH","MM","DD","CC","YY" S:FMT[TIUI FMT=$P(FMT,TIUI)_@TIUI_$P(FMT,TIUI,2)
  1. I FMT["HR" S FMT=$$TIME(X,FMT)
  1. QDATE Q FMT
  1. ;
  1. ACK ; Process ACK HL7 messages
  1. N GMRCMSG,I,X,DONE,MSGID,ERRARY,ERRI
  1. ;Get the message
  1. S ERRI=0
  1. F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
  1. . S GMRCMSG(I,1)=HLNODE
  1. . S X=0 F S X=+$O(HLNODE(X)) Q:'X S GMRCMSG(I,(X+1))=HLNODE(X)
  1. S DONE=0
  1. S I=0 F S I=$O(GMRCMSG(I)) Q:'+I D Q:DONE
  1. . I $P($G(GMRCMSG(I,1)),"|",1)="MSA" D Q
  1. . . I $P($G(GMRCMSG(I,1)),"|",2)="AA" S DONE=1 Q
  1. . . S MSGID=$P($G(GMRCMSG(I,1)),"|",3)
  1. . I $P($G(GMRCMSG(I,1)),"|",1)="ERR" D
  1. . . ;Process Error
  1. . . S ERRI=ERRI+1
  1. . . S ERRARY(ERRI,2)=$P($G(GMRCMSG(I,1)),"|",3)
  1. . . I $P($G(GMRCMSG(I,1)),"|",6)'="" D Q
  1. . . . S ERRARY(ERRI,3)=$P($P($G(GMRCMSG(I,1)),"|",6),"^",4)_"^"_$P($P($G(GMRCMSG(I,1)),"|",6),"^",5)
  1. . . S ERRARY(ERRI,3)=$P($G(GMRCMSG(I,1)),"|",4)
  1. I $D(ERRARY) D MESSAGE(MSGID,.ERRARY)
  1. Q
  1. MESSAGE(MSGID,ERRARY) ; Send a MailMan Message with the errors
  1. N MSGTEXT,DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J
  1. S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. S XMSUB="TIU CCRA Consults to HSRM HL7 Error"
  1. S MSGTEXT(1)=" "
  1. S MSGTEXT(2)="Error in transmitting HL7 message to HSRM"
  1. S MSGTEXT(3)="Date: "_DATE
  1. S MSGTEXT(4)="Message ID: "_MSGID
  1. S MSGTEXT(5)="Error(s):"
  1. S I=0,J=5 F S I=$O(ERRARY(I)) Q:'I D
  1. . S J=J+1,MSGTEXT(J)=" "
  1. . S J=J+1,MSGTEXT(J)=" "_$P($G(ERRARY(I,3)),U)_" - "_$P($G(ERRARY(I,3)),U,2)
  1. . I $P($G(ERRARY(I,2)),U,1)'="" S J=J+1,MSGTEXT(J)=" Segment: "_$P($G(ERRARY(I,2)),U,1)
  1. . I $P($G(ERRARY(I,2)),U,2)'="" S J=J+1,MSGTEXT(J)=" Sequence: "_$P($G(ERRARY(I,2)),U,2)
  1. . I $P($G(ERRARY(I,2)),U,3)'="" S J=J+1,MSGTEXT(J)=" Field: "_$P($G(ERRARY(I,2)),U,3)
  1. . I $P($G(ERRARY(I,2)),U,4)'="" S J=J+1,MSGTEXT(J)=" Fld Rep: "_$P($G(ERRARY(I,2)),U,4)
  1. . I $P($G(ERRARY(I,2)),U,5)'="" S J=J+1,MSGTEXT(J)=" Component: "_$P($G(ERRARY(I,2)),U,5)
  1. . I $P($G(ERRARY(I,2)),U,6)'="" S J=J+1,MSGTEXT(J)=" Sub-component: "_$P($G(ERRARY(I,2)),U,6)
  1. S XMTEXT="MSGTEXT("
  1. S XMDUZ="TIU-CCRA->HSRM Transaction Error"
  1. S XMY("G.GMRC HCP HL7 MESSAGES")=""
  1. D ^XMD
  1. Q
  1. TIUC(X) ; Check each segment of the TIU notes for HL7 control characters
  1. Q:$G(X)=""
  1. I $G(X)[$C(13,10,10) S X=$TR(X,$C(13,10,10),"") ; <cr><lf><lf>
  1. I $G(X)[$C(13,10) S X=$TR(X,$C(13,10),"") ; <cr><lf>
  1. I $G(X)[$C(13) S X=$TR(X,$C(13),"") ; TERM char
  1. I $G(X)[$C(1) S X=$TR(X,$C(1),"") ; SOH
  1. I $G(X)[$C(2) S X=$TR(X,$C(2),"") ; STX
  1. I $G(X)[$C(3) S X=$TR(X,$C(3),"") ; ETX
  1. I $G(X)[$C(4) S X=$TR(X,$C(4),"") ; EOT
  1. I $G(X)[$C(5) S X=$TR(X,$C(5),"") ; ENQ
  1. I $G(X)[$C(6) S X=$TR(X,$C(6),"") ; ACK
  1. I $G(X)[$C(21) S X=$TR(X,$C(21),"") ; NAK
  1. I $G(X)[$C(23) S X=$TR(X,$C(23),"") ; ETB
  1. Q X