TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
;;1.0;TEXT INTEGRATION UTILITIES;**337,344,349,356,366**;Sep 27, 2023;Build 2
; Documented API's and Integration Agreements
; ----------------------------------------------
; IA #3473I GET^GMRCTIU
; ICR 2980 call to CMT^GMRCGUIB
;
;PB - Patch 344 to modify how the note and addendum text is formatted
;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
Q
CONTINUE ;
;
S TIUDA=$G(TIUIEN)
; get document parameters
D DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
;
I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
;
MAKEADD ;
; validate CONSULT title
;S TIU("CNCN")=VNUM
;I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") S TIUZ(1405)=TIU("CNCN")_";GMR(123,"
;
; set appropriate DOCUMENT STATUS from document parameters
S DUZ=$G(TIU("AUDA")),DUZ(2)=$$GETDIV^TIUHL7U1(DUZ),TIU("DIVISION")=DUZ(2)
I $P(TIUDPRM(0),U,2)=1 S TIUZ(.05)=3
I '+$G(TIUZ(.05)),$P(TIUDPRM(0),U,3)>0,$P(TIUDPRM(0),U,3)'>2 S TIUZ(.05)=4
I '+$G(TIUZ(.05)) S TIUZ(.05)=5
;
S TIUZ(.07)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
S TIUZ(1201)=$$NOW^XLFDT
S TIUZ(1202)=$G(TIU("AUDA"))
S TIUZ(1204)=$G(TIU("AUDA"))
S TIUZ(1208)=$G(TIU("CSDA"))
S TIUZ(1205)=$G(VLOC)
S TIUZ(1211)=$G(VLOC)
S TIUZ(1212)=$G(TIU("DIVISION"))
S TIUZ(1301)=$G(TIU("RFDT"))
S TIUZ(1302)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA")),TIU("EBDA")=TIUZ(1302)
S TIUZ(1307)=$G(TIU("DICDT"))
S TIUZ(1701)=$G(TIU("SUB"))
; check if document was found and editable
; if not editable, make addendum
I +$G(TIUDA),'$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
. N PERSON,SUCCESS
. S PERSON=$G(TIU("AUDA"))
. D MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
. ; PB - Patch 349 - add comment for consult factor
. I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
. Q:$G(STOP)=1
. N COMMENT,NOTEDT
. S COMMENT(1)=CFNOTE,NOTEDT=$$NOW^XLFDT,GMRCDA=CONSULTID ; PB - Sep 23 - Patch 356 changed to set GMRCDA to equal CONSULTID instead of VNUM
. D CMT^GMRCGUIB(GMRCDA,.COMMENT,DUZ,NOTEDT,DUZ) ;icr 2980
. S $P(^TIU(8925,+SUCCESS,13),U,3)="U",$P(^TIU(8925,+SUCCESS,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
. D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+SUCCESS) Q
. ; does the ack method below work for CCRA?
. ;D ACK^TIUHL7U1("AA",TIUNAME,SUCCESS),SEND^TIUALRT(SUCCESS),SENDADD^TIUALRT(+TIUDA)
; if editable, make changes to document
I +$G(TIUDA),$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
. N SUCCESS
. D DELTEXT^TIUPUTPN(TIUDA)
. S TIUZ("HDR")="1^1" D SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ) K TIUZ("HDR"),TIUZ("TEXT")
. I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
. Q:$G(STOP)=1
. D FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
. I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
. Q:$G(STOP)=1
. ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
. S $P(^TIU(8925,+SUCCESS,13),U,3)="U",$P(^TIU(8925,+SUCCESS,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
. D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
. ;D ACK^TIUHL7U1("AA",TIUNAME,TIUDA),SEND^TIUALRT(TIUDA) Q
;
I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
;
; document creation
N SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1,ORIGSTAT
S ORIGSTAT=$$GET1^DIQ(123,CONSULTID_",",8,"I") ;ICR 3983 - save the status of the consult before adding the note. PB - Sep 23 - patch 356 changes for lookup by by CONSULTID
;D MAKE^TIUSRVP(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,TIU("VSTR")) ; This calls the FILE^TIUSRVP code which also calls the code to set the status of the consult
;;may need to copy the MAKE^TIUSRVP code to another routine and call our new code and suppress changing the status of the consult.
D MAKE^TIUCCRHL7P2(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,$G(TIU("VSTR")))
;I $G(TIUDA)>0 D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AE",TIUNAME,+TIUDA) Q
I $G(TIUDA)>0 D SIGNDOC^TIUCCRHL7P2(+TIUDA) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA) Q
;
; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
I '+TIUDA S MSGTEXT=$P(TIUDA,U,2) D MESSAGE(MSGID,$G(CONSULTID),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(CONSULTID)) Q ;D ERR^TIUCCHL7UT("TIU",1,"0000.00",$P(TIUDA,U,2)),ACK^TIUHL7U1("AR",TIUNAME,-1) Q
S $P(^TIU(8925,+TIUDA,13),U,3)="U",$P(^TIU(8925,+TIUDA,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
S $P(^TIU(8925,+TIUDA,0),U,7)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
;
; update the consult as necessary
I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") D
. N TIUSTAT S TIUSTAT=$P($G(^TIU(8925,+TIUDA,0)),U,5)
. ;S TIUSTAT=$S(TIUSTAT>4:"COMPLETED",1:"INCOMPLETE") ;CHANGED TIUSTAT>6 TO TIUSTAT>4 ; Dec 28 changed by Phil B. to set TIUSTAT = INCOMPLETE
. S TIUSTAT="INCOMPLETE"
. ;D GET^GMRCTIU(TIU("CNCN"),+TIUDA,TIUSTAT,TIU("AUDA"))
;
D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
D SEND^TIUALRT(+TIUDA)
D AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
;
Q
;
MESSAGE(MSGID,VNUM,MSGTEXT) ; Send a MailMan Message with the errors
N DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,FLG1,MID
S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
S XMSUB="Consult: "_$G(VNUM)_" TIU CCRA Consult Issue from HSRM"
S MSGTEXT(1)=" "
S MSGTEXT(2)="Error Processing TIU Note for Consult ID: "_$G(VNUM)_" from HSRM"
S MSGTEXT(3)="The error is: "_$G(MSGTEXT)
S MSGTEXT(4)="Date: "_DATE
S MSGTEXT(5)="Message ID: "_MSGID
S XMTEXT="MSGTEXT("
S XMDUZ="TIU CONSULT Transaction Error"
S XMDUZ=.5
S XMY("G.TIU HSRM CONSULT HL7 MESSAGES")=""
D ^XMD
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUCCRHL7P3 6365 printed Dec 13, 2024@02:39:07 Page 2
TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,349,356,366**;Sep 27, 2023;Build 2
+2 ; Documented API's and Integration Agreements
+3 ; ----------------------------------------------
+4 ; IA #3473I GET^GMRCTIU
+5 ; ICR 2980 call to CMT^GMRCGUIB
+6 ;
+7 ;PB - Patch 344 to modify how the note and addendum text is formatted
+8 ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
+9 ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
+10 QUIT
CONTINUE ;
+1 ;
+2 SET TIUDA=$GET(TIUIEN)
+3 ; get document parameters
+4 DO DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
+5 ;
+6 IF +TIU("EC")
DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1)
QUIT
+7 ;
MAKEADD ;
+1 ; validate CONSULT title
+2 ;S TIU("CNCN")=VNUM
+3 ;I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") S TIUZ(1405)=TIU("CNCN")_";GMR(123,"
+4 ;
+5 ; set appropriate DOCUMENT STATUS from document parameters
+6 SET DUZ=$GET(TIU("AUDA"))
SET DUZ(2)=$$GETDIV^TIUHL7U1(DUZ)
SET TIU("DIVISION")=DUZ(2)
+7 IF $PIECE(TIUDPRM(0),U,2)=1
SET TIUZ(.05)=3
+8 IF '+$GET(TIUZ(.05))
IF $PIECE(TIUDPRM(0),U,3)>0
IF $PIECE(TIUDPRM(0),U,3)'>2
SET TIUZ(.05)=4
+9 IF '+$GET(TIUZ(.05))
SET TIUZ(.05)=5
+10 ;
+11 SET TIUZ(.07)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
+12 SET TIUZ(1201)=$$NOW^XLFDT
+13 SET TIUZ(1202)=$GET(TIU("AUDA"))
+14 SET TIUZ(1204)=$GET(TIU("AUDA"))
+15 SET TIUZ(1208)=$GET(TIU("CSDA"))
+16 SET TIUZ(1205)=$GET(VLOC)
+17 SET TIUZ(1211)=$GET(VLOC)
+18 SET TIUZ(1212)=$GET(TIU("DIVISION"))
+19 SET TIUZ(1301)=$GET(TIU("RFDT"))
+20 SET TIUZ(1302)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
SET TIU("EBDA")=TIUZ(1302)
+21 SET TIUZ(1307)=$GET(TIU("DICDT"))
+22 SET TIUZ(1701)=$GET(TIU("SUB"))
+23 ; check if document was found and editable
+24 ; if not editable, make addendum
+25 IF +$GET(TIUDA)
IF '$$CANEDIT^TIUHL7U1(TIUDA)
IF '+TIU("EC")
Begin DoDot:1
+26 NEW PERSON,SUCCESS
+27 SET PERSON=$GET(TIU("AUDA"))
+28 DO MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
+29 ; PB - Patch 349 - add comment for consult factor
+30 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
IF '+SUCCESS
SET MSGTEXT=$PIECE(SUCCESS,U,2)
SET STOP=1
DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
+31 if $GET(STOP)=1
QUIT
+32 NEW COMMENT,NOTEDT
+33 ; PB - Sep 23 - Patch 356 changed to set GMRCDA to equal CONSULTID instead of VNUM
SET COMMENT(1)=CFNOTE
SET NOTEDT=$$NOW^XLFDT
SET GMRCDA=CONSULTID
+34 ;icr 2980
DO CMT^GMRCGUIB(GMRCDA,.COMMENT,DUZ,NOTEDT,DUZ)
+35 SET $PIECE(^TIU(8925,+SUCCESS,13),U,3)="U"
SET $PIECE(^TIU(8925,+SUCCESS,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
+36 DO SIGNDOC^TIUHL7U1(+SUCCESS)
IF +TIU("EC")
DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+SUCCESS)
QUIT
+37 ; does the ack method below work for CCRA?
+38 ;D ACK^TIUHL7U1("AA",TIUNAME,SUCCESS),SEND^TIUALRT(SUCCESS),SENDADD^TIUALRT(+TIUDA)
End DoDot:1
QUIT
+39 ; if editable, make changes to document
+40 IF +$GET(TIUDA)
IF $$CANEDIT^TIUHL7U1(TIUDA)
IF '+TIU("EC")
Begin DoDot:1
+41 NEW SUCCESS
+42 DO DELTEXT^TIUPUTPN(TIUDA)
+43 SET TIUZ("HDR")="1^1"
DO SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
KILL TIUZ("HDR"),TIUZ("TEXT")
+44 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
IF '+SUCCESS
SET MSGTEXT=$PIECE(SUCCESS,U,2)
SET STOP=1
DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
+45 if $GET(STOP)=1
QUIT
+46 DO FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
+47 ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
IF '+SUCCESS
SET MSGTEXT=$PIECE(SUCCESS,U,2)
SET STOP=1
DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
+48 if $GET(STOP)=1
QUIT
+49 ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
+50 SET $PIECE(^TIU(8925,+SUCCESS,13),U,3)="U"
SET $PIECE(^TIU(8925,+SUCCESS,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
+51 ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
DO SIGNDOC^TIUHL7U1(+SUCCESS)
IF +TIU("EC")
+52 ;D ACK^TIUHL7U1("AA",TIUNAME,TIUDA),SEND^TIUALRT(TIUDA) Q
End DoDot:1
QUIT
+53 ;
+54 IF +TIU("EC")
DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1)
QUIT
+55 ;
+56 ; document creation
+57 NEW SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1,ORIGSTAT
+58 ;ICR 3983 - save the status of the consult before adding the note. PB - Sep 23 - patch 356 changes for lookup by by CONSULTID
SET ORIGSTAT=$$GET1^DIQ(123,CONSULTID_",",8,"I")
+59 ;D MAKE^TIUSRVP(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,TIU("VSTR")) ; This calls the FILE^TIUSRVP code which also calls the code to set the status of the consult
+60 ;;may need to copy the MAKE^TIUSRVP code to another routine and call our new code and suppress changing the status of the consult.
+61 DO MAKE^TIUCCRHL7P2(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,$GET(TIU("VSTR")))
+62 ;I $G(TIUDA)>0 D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AE",TIUNAME,+TIUDA) Q
+63 IF $GET(TIUDA)>0
DO SIGNDOC^TIUCCRHL7P2(+TIUDA)
IF +TIU("EC")
DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
QUIT
+64 ;
+65 ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
+66 ;D ERR^TIUCCHL7UT("TIU",1,"0000.00",$P(TIUDA,U,2)),ACK^TIUHL7U1("AR",TIUNAME,-1) Q
IF '+TIUDA
SET MSGTEXT=$PIECE(TIUDA,U,2)
DO MESSAGE(MSGID,$GET(CONSULTID),MSGTEXT)
DO ANAK^TIUCCHL7UT(MSGID,$GET(MSGTEXT),$GET(CONSULTID))
QUIT
+67 SET $PIECE(^TIU(8925,+TIUDA,13),U,3)="U"
SET $PIECE(^TIU(8925,+TIUDA,13),U,2)=$SELECT(+$GET(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
+68 SET $PIECE(^TIU(8925,+TIUDA,0),U,7)=$SELECT(+$GET(TIU("EPDT")):TIU("EPDT"),+$GET(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
+69 ;
+70 ; update the consult as necessary
+71 IF $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS")
Begin DoDot:1
+72 NEW TIUSTAT
SET TIUSTAT=$PIECE($GET(^TIU(8925,+TIUDA,0)),U,5)
+73 ;S TIUSTAT=$S(TIUSTAT>4:"COMPLETED",1:"INCOMPLETE") ;CHANGED TIUSTAT>6 TO TIUSTAT>4 ; Dec 28 changed by Phil B. to set TIUSTAT = INCOMPLETE
+74 SET TIUSTAT="INCOMPLETE"
+75 ;D GET^GMRCTIU(TIU("CNCN"),+TIUDA,TIUSTAT,TIU("AUDA"))
End DoDot:1
+76 ;
+77 DO ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
+78 DO SEND^TIUALRT(+TIUDA)
+79 DO AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
+80 ;
+81 QUIT
+82 ;
MESSAGE(MSGID,VNUM,MSGTEXT) ; Send a MailMan Message with the errors
+1 NEW DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,FLG1,MID
+2 SET DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($PIECE(HL("DTM"),"-",1)))
+3 SET XMSUB="Consult: "_$GET(VNUM)_" TIU CCRA Consult Issue from HSRM"
+4 SET MSGTEXT(1)=" "
+5 SET MSGTEXT(2)="Error Processing TIU Note for Consult ID: "_$GET(VNUM)_" from HSRM"
+6 SET MSGTEXT(3)="The error is: "_$GET(MSGTEXT)
+7 SET MSGTEXT(4)="Date: "_DATE
+8 SET MSGTEXT(5)="Message ID: "_MSGID
+9 SET XMTEXT="MSGTEXT("
+10 SET XMDUZ="TIU CONSULT Transaction Error"
+11 SET XMDUZ=.5
+12 SET XMY("G.TIU HSRM CONSULT HL7 MESSAGES")=""
+13 DO ^XMD
+14 QUIT
+15 ;
