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

GMRCHL7H.m

Go to the documentation of this file.
  1. GMRCHL7H ;DSS/KC - Receive HL7 Message for HCP ;Jun 13, 2018@09:30
  1. ;;3.0;CONSULT/REQUEST TRACKING;**75,85,96,88**;DEC 27, 1997;Build 153
  1. ;
  1. ;DBIA# Supported Reference
  1. ;----- --------------------------------
  1. ;2051 FIND^DIC
  1. ;2056 GET1^DIQ
  1. ;2161 INIT^HLFNC2
  1. ;2164 GENERATE^HLMA
  1. ;2541 KSP^XUPARAM
  1. ;2944 TGET^TIUSRVR1
  1. ;3267 SSN^DPTLK1
  1. ;3630 BLDPID^VAFCQRY
  1. ;4069 ^HL(772
  1. ;4966 ^HLMA
  1. ;5807 GETLINK^TIUSRVT1
  1. ;10103 FMTE^XLFDT, FMTHL7^XLFDT
  1. ;10104 UP^XLFSTR
  1. ;10106 FMDATE^HLFNC
  1. ;;Patch 85 fix for CA SDM ticket R6063960FY16
  1. ;;Patch 88 add consult no. and FSC support to MESSAGE
  1. ;
  1. EN(MSG) ;Entry point to routine from GMRC CONSULTS TO HCP protocol attached or GMRC EVSEND OR
  1. ;MSG = local array which contains the HL7 segments
  1. N I,QUIT,MSGTYP,DFN,ORC,GMRCDA,FS,MSGTYP2,MSGTYP3,ACTIEN,FROMSVC,OK,OKFROM,STATUS
  1. N UCID ;ABV/SCR 12/14/2017 *96*
  1. S (I,QUIT)=0,I=$O(MSG(I)) Q:'I S MSG=MSG(I) Q:$E(MSG,1,3)'="MSH" D Q:QUIT
  1. .S FS=$E(MSG,4) I $P(MSG,FS,3)'="CONSULTS" S QUIT=1 Q
  1. .S MSGTYP=$P(MSG,FS,9) I ",ORR,ORM,"'[","_MSGTYP_"," S QUIT=1 Q ;ORR is new consult, ORM are updates
  1. .Q
  1. F S I=$O(MSG(I)) Q:'I!QUIT S MSG=MSG(I) D
  1. .I $E(MSG,1,3)="PID" S DFN=$P(MSG,FS,4) I 'DFN!('$D(^DPT(DFN))) S QUIT=1 Q
  1. .I $E(MSG,1,3)="ORC" S ORC=MSG S GMRCDA=+$P(ORC,FS,4),MSGTYP2=$P(ORC,FS,2),MSGTYP3=$P(ORC,FS,6) D
  1. ..I MSGTYP3="IP" S ACTIEN=$O(^GMR(123,GMRCDA,40,99999),-1) D
  1. ...I ACTIEN S FROMSVC=$P($G(^GMR(123,GMRCDA,40,ACTIEN,0)),U,6) I FROMSVC S OKFROM=$$FEE(FROMSVC)
  1. ..S OK=$$FEE($$GET1^DIQ(123,GMRCDA,1,"I"))
  1. ..I '$G(OKFROM)&'$G(OK) S QUIT=1 ;not a Fee service or not forwarded from a fee service
  1. ..Q
  1. .Q
  1. Q:QUIT
  1. I MSGTYP="ORR" S MSGTYP3="NW"
  1. S STATUS=$$STATUS(MSGTYP2,MSGTYP3) I STATUS="UNKNOWN" Q ;don't process anything we haven't coded for
  1. ;done verifying this consult needs to go to HCP, start building HL7 message
  1. N SNAME,GMRCHL,ZERR,ZCNT,ECH,DATA,GDATA,URG,TYP,RES,EFFDT,PDUZ,PN,ADDR,PH,GMRCP,SENS,DX,DXCODE
  1. S SNAME="GMRC HCP REF-"_$S(MSGTYP2="DR":"I14",MSGTYP="ORR":"I12",MSGTYP2="OC":"I14",MSGTYP2="OD":"I14",1:"I13")_" 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. ;start creating the segments.
  1. S DATA=$NA(^TMP("GMRCHL7H",$J)) K @DATA D GETS^DIQ(123,GMRCDA,"*","IE",DATA)
  1. S GDATA=$NA(^TMP("GMRCHL7H",$J,123,+GMRCDA_",")) ;File 123 data
  1. ;RF1 segment
  1. K GMRCM
  1. S URG=$G(@GDATA@(5,"E")) ;I URG]"" S URG=$S(URG["ROUTINE":"R",URG["STAT":"S",1:"A")
  1. S URG=$P(URG,"- ",2)
  1. S TYP=$G(@GDATA@(1,"I"))_ECH_$G(@GDATA@(1,"E")) D GETLINK^TIUSRVT1(.RES,+TYP_";GMR(123.5,")
  1. S TYP=TYP_ECH_ECH_$P($G(RES),U)_ECH_$P($G(RES),U,4)
  1. S EFFDT=$$FMTHL7^XLFDT($G(@GDATA@(.01,"I")))
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="RF1|"_STATUS_"|"_URG_"|"_TYP_"||"_$G(@GDATA@(14,"I"))_"|"_GMRCDA_"|"_EFFDT_"||||"
  1. ;**ABV/PIJ 10/10/2017 *96*- update RF1 segment
  1. S UCID=$$GET1^DIQ(123,GMRCDA,80)
  1. S:$G(UCID)'="" GMRCM(ZCNT)="RF1|"_STATUS_"|"_URG_"|"_TYP_"||"_$G(@GDATA@(14,"I"))_"|"_UCID_"|"_EFFDT_"||||"
  1. S:$G(UCID)="" ^XTMP("GMRCHL7H","UCID IS EMPTY",GMRCDA)=GMRCDA ;TEMP ERROR HANDLER
  1. ;*96*
  1. ;PRD segment
  1. S PDUZ=$G(@GDATA@(10,"I")),PN=$G(@GDATA@(10,"E")),PN=$$HLNAME^XLFNAME(PN,"S",ECH),$P(PN,ECH,9)=PDUZ
  1. S ADDR=$$ADDR^GMRCHL7P(PDUZ,.GMRCHL),PH=$$PH^GMRCHL7P(PDUZ,.GMRCHL)
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="PRD|RP|"_PN_"|"_$G(ADDR)_"||"_$G(PH)_"|"
  1. ;PID segment May be multiple nodes in the return array - make nodes 2-n sub nodes
  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. ;DG1 segment ;Patch 85 modified
  1. S DX=$G(@GDATA@(30,"E"))
  1. S DXCODE=$G(@GDATA@(30.1,"E"))
  1. I $G(DX)["(" S DX=$P(DX,"(")
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="DG1|1||"_$G(DXCODE)_ECH_$G(DX)_"|||W"
  1. ;OBR segment
  1. S ZCNT=ZCNT+1,GMRCM(ZCNT)="OBR|1|"_$P(ORC,FS,3)_"|"_$P(ORC,FS,4)_"|ZZ||"_$$FMTHL7^XLFDT($G(@GDATA@(17,"I")))
  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|1|"_$S(VAIP(13):"I",1:"O")_"|||||"_VAIP(18)_"|"
  1. I VAIP(5) S $P(GMRCM(ZCNT),"|",4)=VAIP(5) ;location for last movement event
  1. S SENS=$$SSN^DPTLK1(DFN) I SENS["*SENSITIVE*" S $P(GMRCM(ZCNT),"|",17)="R" ;sensitive patient
  1. S $P(GMRCM(ZCNT),"|",18)=VAIP(13,5)
  1. D KVA^VADPT
  1. ;NTE segment
  1. D NTE(.GMRCHL)
  1. K ^TMP("GMRCHL7H",$J)
  1. ;
  1. ; When done, re-serve the (modified) referral message to HCP
  1. N HL,HLA,GMRCRES,GMRCHLP
  1. M HL=GMRCHL,HLA("HLS")=GMRCM
  1. M GMRCHL=^XTMP("GMRCHL7H","MESSAGE")
  1. D GENERATE^HLMA(GMRCHL("EID"),"LM",1,.GMRCRES,"",.GMRCHLP)
  1. Q
  1. NTE(HL) ;Find Reason for Request for New or Resubmit entries, Find TIU for complete, find Activity Comment for others
  1. N NTECNT,X S NTECNT=1
  1. I (MSGTYP="ORR"&(MSGTYP2'="DR"))!((MSGTYP3="IP")&'$G(OKFROM)) D Q
  1. .D AUTHDTTM
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"|P|Reason for Request"
  1. .S I=0 F S I=$O(@GDATA@(20,I)) Q:'I S X=@GDATA@(20,I) Q:X["^TMP" D
  1. ..S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
  1. ..I X=$C(9,9) Q
  1. ..D HL7TXT^GMRCHL7P(.X,.HL,"\")
  1. ..S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||"_X
  1. ..Q
  1. .Q
  1. ; Build NTE for CM^ADDENDED
  1. I MSGTYP2="XX",MSGTYP3="CM" D Q
  1. .N GMRCN,GMRCTXT,GMRCCMP,GMRCASTR
  1. .D AUTHDTTM
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"|P|Progress Note"
  1. .S GMRCN=$P($G(^GMR(123,GMRCDA,50,1,0)),U) I GMRCN'["TIU(8925," Q
  1. .D TGET^TIUSRVR1(.GMRCTXT,$S(+$G(GMRCPARN):+GMRCPARN,+$G(TIUDA):+TIUDA,1:+GMRCN),"VIEW")
  1. .;
  1. .S GMRCCMP=$$DATE($P($G(^TIU(8925,+TIUDA,13)),U),"MM/DD/CCYY")_" ADDENDUM"_" STATUS: "_$$GET1^DIQ(8925,+TIUDA_",",.05)
  1. .S (I,GMRCASTR)=0
  1. .F S I=$O(@GMRCTXT@(I)) Q:I="" S X=@GMRCTXT@(I) D
  1. ..I X=GMRCCMP S GMRCASTR=I
  1. .;
  1. .I GMRCASTR D
  1. ..S I=GMRCASTR-1
  1. ..F S I=$O(@GMRCTXT@(I)) Q:I="" S X=@GMRCTXT@(I) D
  1. ...S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
  1. ...D HL7TXT^GMRCHL7P(.X,.HL,"\")
  1. ...S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||"_X
  1. .K ^TMP("TIUVIEW",$J) ;clean up results of TIUSRVR1 call
  1. ;
  1. I MSGTYP3="CM" D Q
  1. .N GMRCN,GMRCTXT
  1. .D AUTHDTTM
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"|P|Progress Note"
  1. .S GMRCN=$P($G(^GMR(123,GMRCDA,50,1,0)),U) I GMRCN'["TIU(8925," Q
  1. .D TGET^TIUSRVR1(.GMRCTXT,$S(+$G(TIUDA):+TIUDA,1:+GMRCN),"VIEW") S I=0
  1. .F S I=$O(@GMRCTXT@(I)) Q:I="" S X=@GMRCTXT@(I) D
  1. ..S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
  1. ..D HL7TXT^GMRCHL7P(.X,.HL,"\")
  1. ..S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||"_X
  1. ..Q
  1. .K ^TMP("TIUVIEW",$J) ;clean up results of TIUSRVR1 call
  1. .Q
  1. I (MSGTYP2="DR") D Q
  1. .N ORIEN,CMT
  1. .D AUTHDTTM
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"|L|Activity Comment"
  1. .S ORIEN=$G(@GDATA@(.03,"I")) I 'ORIEN Q
  1. .S CMT=$$GET1^DIQ(100,ORIEN_",",64),CMT=$$TRIM^XLFSTR(CMT)
  1. .D HL7TXT^GMRCHL7P(.CMT,.HL,"\")
  1. .S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|2||"_CMT
  1. .Q
  1. N ACT,ACTD,ACTIEN,Q
  1. S Q=0,ACTIEN=9999 F S ACTIEN=$O(^GMR(123,GMRCDA,40,ACTIEN),-1) Q:'ACTIEN!Q S X=$G(^GMR(123,GMRCDA,40,ACTIEN,0)) D
  1. .S ACT=$P(X,U,2),ACTD=$P($P($G(^GMR(123.1,+ACT,0)),U)," ")
  1. .I $P($P(STATUS,ECH,2)," ")'=ACTD Q
  1. .I +$O(^GMR(123,GMRCDA,40,ACTIEN,1,0)) D AUTHDTTM
  1. .S I=0 F S I=$O(^GMR(123,GMRCDA,40,ACTIEN,1,I)) Q:'I S X=$G(^GMR(123,GMRCDA,40,ACTIEN,1,I,0)) D
  1. ..I 'Q S ZCNT=ZCNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"|L|Activity Comment",Q=1
  1. ..S X=$$TRIM^XLFSTR(X) I $L(X)=0 Q
  1. ..D HL7TXT^GMRCHL7P(.X,.HL,"\")
  1. ..S ZCNT=ZCNT+1,NTECNT=NTECNT+1,GMRCM(ZCNT)="NTE|"_NTECNT_"||"_X
  1. ..Q
  1. .Q
  1. Q
  1. AUTHDTTM ; Add Author and Date/Time to NTE
  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. STATUS(T1,T2) ;get status for event
  1. ;also add IP^COMMENT when those events are captured
  1. I T2="DC"!(T1="DR") Q "DC^DISCONTINUED"
  1. I T2="NW" Q "NW^CPRS RELEASED ORDER"
  1. I T1="SC"&(T2="SC") Q "SC^RECEIVED"
  1. I T1="SC"&(T2="ZC") Q "SC^SCHEDULED"
  1. I T1="XX"&(T2="XX") Q "IP^ADDED COMMENT"
  1. I T2="CA" Q "CA^CANCELLED"
  1. I T2="CM" D
  1. .I '+$G(GMRCPARN),'+$G(TIUDA) S GMRCPARN=$P($G(^GMR(123,GMRCDA,50,1,0)),U)
  1. .S $P(ORC,FS,4)=$S(+$G(GMRCPARN):+GMRCPARN_";TIU^TIU",+$G(TIUDA):+TIUDA_";TIU^TIU",1:$P(ORC,FS,4))
  1. I T1="XX"&(T2="CM") Q "CM^ADDENDED"
  1. I T2="CM" Q "CM^COMPLETE"
  1. I T1="XX"&(T2="IP")&$G(OKFROM) Q "XX^FORWARDED"
  1. I T1="XX"&(T2="IP") Q "IP^RESUBMITTED"
  1. Q "UNKNOWN"
  1. FEE(FEESVC) ;send only if name contains HCPS
  1. I $G(FEESVC)="" Q 0
  1. N VAL
  1. S VAL=0
  1. I $$UP^XLFSTR($$GET1^DIQ(123.5,FEESVC,.01,"E"))["HCPS" S VAL=1
  1. Q VAL
  1. COMMENT(GMRCDA) ;send comments on Non VA Care consults to HCP
  1. ;create a fake event for HCP since there is no HL7 event passed to GMRC EVSEND OR
  1. I '$G(GMRCDA) Q
  1. N DFN S DFN=$$GET1^DIQ(123,GMRCDA,.02,"I") I 'DFN,'$D(^DPT(DFN)) Q
  1. N T S T(1)="MSH|^~\&|CONSULTS||||||ORM"
  1. S T(2)="PID|||"_DFN
  1. S T(4)="ORC|XX|"_$$GET1^DIQ(123,GMRCDA,.03,"I")_";"_$$OITEM($$GET1^DIQ(123,GMRCDA,.03,"I"))_"^OR|"_GMRCDA_";GMRC^GMRC||XX|"
  1. D EN(.T)
  1. Q
  1. ADDEND(TIUDA) ;send addendums on Non VA Care consults to HCP
  1. ;create a fake event for HCP since there is no HL7 event passed to GMRC EVSEND OR
  1. I '$G(TIUDA) Q
  1. Q:'$D(^TIU(8925,+TIUDA,0))
  1. N TIUTYP,DFN,GMRCPARN,GMRCO,GMRCD,GMRCDA,GMRCD1,GMRC8925,T
  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. 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. S T(1)="MSH|^~\&|CONSULTS||||||ORM"
  1. S T(2)="PID|||"_DFN
  1. S T(4)="ORC|XX|"_$$GET1^DIQ(123,GMRCO,.03,"I")_";"_$$OITEM($$GET1^DIQ(123,GMRCO,.03,"I"))_"^OR|"_GMRCO_";GMRC^GMRC||CM|"
  1. I $$FEE($$GET1^DIQ(123,GMRCO,1,"I")) D EN(.T)
  1. Q
  1. TIME(X,FMT) ; Copied from $$TIME^TIULS
  1. ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
  1. N HR,MIN,SEC,GMRCI
  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 GMRCI="HR","MIN","SEC" S:FMT[GMRCI FMT=$P(FMT,GMRCI)_@GMRCI_$P(FMT,GMRCI,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,GMRCI,GMRCTMP
  1. I +X'>0 S $P(GMRCTMP," ",$L($G(FMT))+1)="",FMT=GMRCTMP 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 GMRCI="AMTH","MM","DD","CC","YY" S:FMT[GMRCI FMT=$P(FMT,GMRCI)_@GMRCI_$P(FMT,GMRCI,2)
  1. I FMT["HR" S FMT=$$TIME(X,FMT)
  1. QDATE Q FMT
  1. OITEM(GMRCORDN) ; Orderable Item
  1. N RETVAL,GMRCOITM
  1. S RETVAL=1
  1. S GMRCOITM=+$O(^OR(100,GMRCORDN,.1,0))
  1. I GMRCOITM D
  1. .S RETVAL=+$G(^OR(100,GMRCORDN,.1,GMRCOITM,0))
  1. .I 'RETVAL S RETVAL=1
  1. Q RETVAL
  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,I,FSCGRP,GMRCSTA,GMRCSTNA,GMRCNO,GMRCTEXT
  1. S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. S FSCGRP=$$GET^XPAR("SYS","GMRC FSC HCP SUPPORT EMAIL",1)
  1. S XMSUB="GMRC Consults to HCP HL7 Error"
  1. S (GMRCSTA,GMRCSTNA)="",GMRCSTA=$$KSP^XUPARAM("INST")
  1. I +$G(GMRCSTA)>0 D F4^XUAF4(GMRCSTA,.GMRCSTNA)
  1. S GMRCTEXT=$S($G(GMRCSTNA)>0:GMRCSTNA("NAME")_" ("_GMRCSTA_")",1:"Not Found")
  1. S GMRCNO=$$HLTEXT(MSGID)
  1. S MSGTEXT(1)=" "
  1. S MSGTEXT(2)="Error in transmitting HL7 message to HCP"
  1. S MSGTEXT(3)="Date: "_DATE
  1. S MSGTEXT(4)="Message ID: "_MSGID
  1. S MSGTEXT(5)="Facility: "_GMRCTEXT
  1. S MSGTEXT(6)="Consult No.: "_$S(+$G(GMRCNO)>0:GMRCNO,1:"Not Found")
  1. S MSGTEXT(7)="Error(s):"
  1. S I=0,J=7 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->HCP Transaction Error"
  1. S XMY("G.GMRC HCP HL7 MESSAGES")=""
  1. S:$G(FSCGRP)'="" XMY(FSCGRP)=""
  1. D ^XMD
  1. Q
  1. HLTEXT(MSGID) ;get hl7 message text; find obr and get consult record number
  1. N GMRCWPTX,GMRCMSID,GMRCOBR,GMRCIFN,I,GMRC773,GMRC772,GMRCNDX,GMRCFLG,GMRCOUT,GMRCERR,IDX
  1. S GMRCIFN=0,GMRCNDX="C",GMRCFLG="I",IDX=""
  1. D FIND^DIC(773,"","@;.01I;IX","X",MSGID,"*","C","","","GMRCOUT","GMRCERR")
  1. I $D(GMRCERR)>0 Q GMRCIFN
  1. I +GMRCOUT("DILIST",0)'>0 Q GMRCIFN
  1. S IDX=$O(GMRCOUT("DILIST",2,""))
  1. S:+IDX>0 GMRC773=GMRCOUT("DILIST",2,IDX)
  1. I +$G(GMRC773)'>0 Q GMRCIFN
  1. S GMRC772=$$GET1^DIQ(773,GMRC773_",",.01,GMRCFLG)
  1. I +$G(GMRC772)'>0 Q GMRCIFN
  1. S GMRCMSID=$$GET1^DIQ(772,GMRC772_",",200,"","GMRCWPTX")
  1. S I=0
  1. F S I=I+1 Q:'$D(GMRCWPTX(I)) D
  1. .Q:GMRCWPTX(I)'["OBR"
  1. .S GMRCOBR=GMRCWPTX(I)
  1. .S:$P(GMRCOBR,"|",4)["GMRC" GMRCIFN=$P(GMRCOBR,"|",4),GMRCIFN=$P(GMRCIFN,";")
  1. Q GMRCIFN