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

GMRCCCR1.m

Go to the documentation of this file.
  1. GMRCCCR1 ;COG/PB - Receive HL7 Message for HCP ;3/21/18 09:00
  1. ;;3.0;CONSULT/REQUEST TRACKING;**99,106,112,123,134,146,158,173,203**;JUN 1, 2018;Build 6
  1. ;
  1. ;DBIA# Supported Reference
  1. ;----- --------------------------------
  1. ;10106 HLADDR^HLFNC
  1. ;4648 TFL^VAFCTFU2
  1. ;
  1. ; MJ - 5/24/2018 patch 106 changes to add - GETADD function
  1. ; MJ - 2/28/2019 patch 112 subroutines added or split from GMRCCCRA
  1. ; MJ - 4/02/2019 patch 123 updated to find VistA user from HSRM message and create NAK if invalid
  1. ; MJ - 7/30/2019 patch 134 fix control character issue in TIU notes
  1. ; MJ - 9/20/2019 patch 146 clear space-only address fields
  1. ; PB - 6/22/2021 patch 173 to pull the EDIPI and add it to the PID segment
  1. ;
  1. Q
  1. ;
  1. GETADD(INSP) ;
  1. ; INSP contains internal value of insurance plan for this patient (IN1 segment)
  1. N ADDLN1,ADDLN2,ADDLN3,ADDCITY,ADDST,ADDZIP,VADD,VCSZ,X
  1. S ADDLN1=$$GET1^DIQ(36,INSP_",",.111)
  1. S ADDLN2=$$GET1^DIQ(36,INSP_",",.112)
  1. S ADDLN3=$$GET1^DIQ(36,INSP_",",.113)
  1. S ADDCITY=$$GET1^DIQ(36,INSP_",",.114)
  1. S ADDST=$$GET1^DIQ(36,INSP_",",.115,"I") ; S:ADDST ADDST=ADDST_"~"_$$GET1^DIQ(36,INSP_",",.115)
  1. S ADDZIP=$$GET1^DIQ(36,INSP_",",.116)
  1. S VADD=ADDLN1_"^"_ADDLN2,VCSZ=ADDCITY_"^"_ADDST_"^"_ADDZIP
  1. S X=$$HLADDR^HLFNC(VADD,VCSZ)
  1. S:X]"" $P(X,"^",7)="M" ; address type = 'mailing'
  1. Q X
  1. ; end patch 106 mod
  1. ;
  1. CLRADD(ADDRESS) ;
  1. ; patch 146 - take any address field that contains only spaces and change to null
  1. N I,J,ADD
  1. F I=1:1:$L(ADDRESS,"^") D ;
  1. . S ADD=$P(ADDRESS,"^",I) I $L(ADD) D ;
  1. .. F Q:$E(ADD,1)'=" " S ADD=$E(ADD,2,$L(ADD))
  1. .. S $P(ADDRESS,"^",I)=ADD
  1. Q ADDRESS
  1. ;
  1. MESSAGE(MSGID,ERRARY) ; Send a MailMan Message with the errors
  1. ; moved here for patch 112
  1. N MSGTEXT,DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,I,J
  1. S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. S XMSUB="GMRC 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="GMRC-CCRA->HSRP Transaction Error"
  1. S XMY("G.GMRC HCP HL7 MESSAGES")=""
  1. D ^XMD
  1. Q
  1. ;
  1. MESSAGE2(MSGID,ABORT,CONID) ; Send a MailMan Message with the errors
  1. N MSGTEXT,DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,SITE,MSG
  1. S SITE=$$KSP^XUPARAM("INST")
  1. S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. S XMSUB="Consult ID "_CONID_" - GMRC CCRA Scheduling Updates from HSRM - HL7 Error"
  1. S MSGTEXT(1)=" "
  1. S MSGTEXT(2)="Error in receiving HL7 message from HSRM"
  1. S MSGTEXT(3)="Date: "_DATE
  1. S MSGTEXT(4)="Message ID: "_MSGID
  1. S MSG="Error(s): "_$P(ABORT,"^",2)_"/VISTA "_SITE_"/Consult ID:"_CONID_". Please manually synchronize the consult"
  1. S MSG=MSG_" in VistA #"_SITE_" with the information currently available in HSRM."
  1. S MSGTEXT(5)=MSG
  1. S XMTEXT="MSGTEXT("
  1. S XMDUZ="GMRC-CCRA <-HSRM Transaction Error"
  1. S XMY("G.GMRC HSRM SIU HL7 MESSAGES")="" ; ** CHECK THIS OUT **
  1. D ^XMD
  1. Q
  1. ;
  1. CCONTROL(GMRCDA) ; patch 112
  1. ; remove control characters from data before building OBR segment
  1. ;
  1. S YY=0 F S YY=$O(^GMR(123,GMRCDA,40,YY)) Q:YY'>0 D
  1. .S XX=0 F S XX=$O(^GMR(123,GMRCDA,40,YY,1,XX)) Q:XX'>0 D
  1. ..K NODE
  1. .. ;S TESTSTRING=$C(13)
  1. ..S NODE=$G(^GMR(123,GMRCDA,40,YY,1,XX,0))
  1. ..I $G(NODE)[$C(13,10,10) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(13,10,10)," ") ; <cr><lf><lf>
  1. ..I $G(NODE)[$C(13,10) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(13,10)," ") ; <cr><lf>
  1. ..I $G(NODE)[$C(13) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(13)," ") ; TERM char
  1. ..I $G(NODE)[$C(1) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(1)," ") ; SOH
  1. ..I $G(NODE)[$C(2) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(2)," ") ; STX
  1. ..I $G(NODE)[$C(3) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(3)," ") ; ETX
  1. ..I $G(NODE)[$C(4) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(4)," ") ; EOT
  1. ..I $G(NODE)[$C(5) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(5)," ") ; ENQ
  1. ..I $G(NODE)[$C(6) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(6)," ") ; ACK
  1. ..I $G(NODE)[$C(21) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(21)," ") ; NAK
  1. ..I $G(NODE)[$C(23) S ^GMR(123,GMRCDA,40,YY,1,XX,0)=$TR(^GMR(123,GMRCDA,40,YY,1,XX,0),$C(23)," ") ; ETB
  1. ..;I $C(13,10,10)[$G(NODE) W !,XX," ",NODE
  1. ..K NODE ;,TESTSTRING
  1. K XX,YY
  1. Q
  1. ;
  1. ANAK(NAKMSG,USERMAIL,ICN,DFN,CONID,GMRCDT) ; Application Error, send NAK back
  1. N PATNAME,EID,EIDS,MSGN,SITE,CONPAT,RES,NAKMSG1
  1. Q:$G(NAKMSG)=""
  1. Q:$G(DFN)'>0
  1. Q:$G(CONID)=""
  1. Q:$G(GMRCDT)=""
  1. Q:$G(^DPT(DFN,0))=""
  1. S CONPAT=$$GET1^DIQ(123,CONID_",",.02,"I")
  1. Q:$G(CONPAT)'=DFN ;Patient in appt msg not the same as patient in the consult
  1. S PATNAME=$P(^DPT(DFN,0),"^"),SITE=$$KSP^XUPARAM("INST")
  1. S:$G(ICN)="" ICN=$P(^DPT(DFN,"MPI"),"^",10)
  1. S EID=$G(HL("EID"))
  1. S EIDS=$G(HL("EIDS"))
  1. S MSGN=$G(HL("MID"))
  1. ; S NAKMSG1=NAKMSG_"/VISTA "_SITE_"/Consult ID:"_CONID_". Please manually synchronize the consult"
  1. ; S NAKMSG1=NAKMSG1_" in VistA #"_SITE_" with the information currently available in HSRM."
  1. S HLA("HLA",1)="MSA|AE|"_$G(MSGN)_"|"_$G(USERMAIL)_" "_$G(NAKMSG)_"|||"_$G(ICN)_"^"_$G(PATNAME)_"^"_SITE_"^"_CONID_"^"_GMRCDT
  1. D GENACK^HLMA1(EID,$G(HLMTIENS),EIDS,"LM",1,.RES)
  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. I $G(X)[$C(11) S X=$TR(X,$C(11)," ") ; TAB with space
  1. Q X
  1. ADDEND ; moved from ADDEND^GMRCCCRA routine for space ; patch 146 ; MJ
  1. ; returns 0 if value not found
  1. ;
  1. ; modified in patch GMRC*3.0*106 to use ICR 2693
  1. D EXTRACT^TIULQ(TIUDA)
  1. ;
  1. ; Quit if not an addendum
  1. S TIUTYP=^TMP("TIULQ",$J,+TIUDA,.01,"I")
  1. I TIUTYP'=81 Q 0
  1. ;
  1. S DFN=^TMP("TIULQ",$J,+TIUDA,.02,"I")
  1. I 'DFN!('$D(^DPT(DFN))) Q 0
  1. ;
  1. ; Get parent note IEN, if addendum IEN is passed in:
  1. S GMRCPARN=^TMP("TIULQ",$J,+TIUDA,.06,"I")
  1. ;
  1. ; Quit if not an addendum
  1. ;S TIUTYP=$$GET1^DIQ(8925,TIUDA,.01,"I")
  1. ;I TIUTYP'=81 Q
  1. ;
  1. ;S DFN=$$GET1^DIQ(8925,TIUDA,.02,"I")
  1. ;I 'DFN,'$D(^DPT(DFN)) Q
  1. ;
  1. ; Get parent note IEN, if addendum IEN is passed in:
  1. ;S GMRCPARN=$$GET1^DIQ(8925,TIUDA,.06,"I")
  1. ;
  1. ; end patch 106 mods
  1. ;
  1. S (GMRCO,GMRCD)=0
  1. F S GMRCD=$O(^GMR(123,"AD",DFN,GMRCD)) Q:'GMRCD!(GMRCO) D
  1. .S GMRCDA=0
  1. .F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCD,GMRCDA)) Q:'GMRCDA!(GMRCO) D
  1. ..S GMRCD1=0
  1. ..F S GMRCD1=$O(^GMR(123,GMRCDA,50,GMRCD1)) Q:'GMRCD1!(GMRCO) D
  1. ...S GMRC8925=$$GET1^DIQ(123.03,GMRCD1_","_GMRCDA_",",.01,"I")
  1. ...I +GMRC8925=$S(+GMRCPARN:+GMRCPARN,1:TIUDA) S GMRCO=GMRCDA
  1. Q GMRCO
  1. ;
  1. AUTHDTTM ;
  1. S ACTIEN=$G(ACTIEN,$O(^GMR(123,GMRCDA,40,99999),-1))
  1. I '+ACTIEN D Q
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Author\R\\R\"
  1. .S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Datetime\R\\R\"
  1. .S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Comment\R\\R\"
  1. .S NTECNT=4
  1. ;
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Author\R\\R\"_$$GET1^DIQ(123.02,ACTIEN_","_GMRCDA_",",4)
  1. S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Datetime\R\\R\"_$$FMTHL7^XLFDT($$GET1^DIQ(123.02,ACTIEN_","_GMRCDA_",",2,"I"))
  1. S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||Comment\R\\R\"
  1. S NTECNT=4
  1. Q
  1. ACK ;
  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. EDIPI(DFN,GMRCP) ;
  1. N EDIPI,ICN,PT,LST,XX,HSRMEDIPI,PIDSEG,PID,YY,LCNT,NUMSEGS,PIDLEN,SEGCNT,PIDLEN1,PATID,NGMRCP,FIELDS,FIELDS1,TMPGMRCP
  1. Q:$G(DFN)'>0
  1. Q:$G(GMRCP(1))=""
  1. S ICN=$$GETICN^MPIF001(DFN),EDIPI=""
  1. Q:$G(ICN)=""
  1. S PT=ICN_"^NI^USVHA^200M"
  1. D TFL^VAFCTFU2(.LST,PT)
  1. ;I $P(LST(1),"^")=-1 S PT=DFN_"^PI^USVHA^"_$$KSP^XUPARAM("INST")
  1. ;Q:$P(LST(1),"^")=-1
  1. S XX=0 F S XX=$O(LST(XX)) Q:XX'>0 D
  1. .I $P(LST(XX),"^",3)="USDOD" D
  1. ..Q:$P(LST(XX),"^",5)="H"
  1. ..S EDIPI=$P(LST(XX),"^")
  1. ;For the first patch after 203, modify the line below to I $G(EDIPI)="" S GMRCP=1 Q
  1. I $G(EDIPI)="" M NEWGMRCP=GMRCP Q
  1. ;N HSRMEDIPI
  1. S HSRMEDIPI=EDIPI_"^^^USDOD&&0363^EDIPI^VA FACILITY&200DOD&L"
  1. K XX
  1. K PID,PIDSEG
  1. S PID="",(NGMRCP,XX)=0 F S XX=$O(GMRCP(XX)) Q:$G(XX)'>0 D
  1. .S NGMRCP=NGMRCP+1
  1. .S PID=PID_$G(GMRCP(XX))
  1. K I S (FIELDS1,FIELDS,NUMSEGS,SEGCNT)=0,LCNT=1
  1. S PIDLEN=$L(PID) F I=1:1:PIDLEN I $E(PID,I)="|" S FIELDS=FIELDS+1
  1. S PATID=HSRMEDIPI_"~"_$P(PID,"|",4)
  1. S:PATID'="" $P(PID,"|",4)=PATID
  1. S PIDLEN1=$L(PID) F I=1:1:PIDLEN1 I $E(PID,I)="|" S FIELDS1=FIELDS1+1
  1. K I F I=1:1:NGMRCP ;K GMRCP(I)
  1. S NUMSEGS=PIDLEN1/240 I $P(NUMSEGS,".",2)>0 S SEGCNT=$P(NUMSEGS,".",1)+1
  1. K I F I=1:1:PIDLEN1 Q:LCNT>SEGCNT S ^TMP($J,"GMRCP",(LCNT))=$E(PID,I,I+240),I=I+240,LCNT=LCNT+1
  1. ;S GMRCP=PID
  1. M NEWGMRCP=^TMP($J,"GMRCP")
  1. Q