- 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 Feb 19, 2025@00:05:33 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