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

TIUCCRHL7P3.m

Go to the documentation of this file.
  1. TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**337,344,349,356,366,371**;Sep 27, 2023;Build 4
  1. ; Documented API's and Integration Agreements
  1. ; ----------------------------------------------
  1. ; IA #3473I GET^GMRCTIU
  1. ; ICR 2980 call to CMT^GMRCGUIB
  1. ;
  1. ;PB - Patch 344 to modify how the note and addendum text is formatted
  1. ;PB - Patch 349 modification to parse and file the consult factor from the note and file as a comment with the consult
  1. ;PB - Patch 356 modifications to file the note as a stand-alone note and not linked to a consult
  1. ;PB - Patch 371 removes unused code
  1. Q
  1. CONTINUE ;
  1. S TIUDA=$G(TIUIEN)
  1. ; get document parameters
  1. D DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
  1. I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
  1. MAKEADD ;
  1. ; validate CONSULT title
  1. ; set appropriate DOCUMENT STATUS from document parameters
  1. S DUZ=$G(TIU("AUDA")),DUZ(2)=$$GETDIV^TIUHL7U1(DUZ),TIU("DIVISION")=DUZ(2)
  1. I $P(TIUDPRM(0),U,2)=1 S TIUZ(.05)=3
  1. I '+$G(TIUZ(.05)),$P(TIUDPRM(0),U,3)>0,$P(TIUDPRM(0),U,3)'>2 S TIUZ(.05)=4
  1. I '+$G(TIUZ(.05)) S TIUZ(.05)=5
  1. S TIUZ(.07)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
  1. S TIUZ(1201)=$$NOW^XLFDT
  1. S TIUZ(1202)=$G(TIU("AUDA"))
  1. S TIUZ(1204)=$G(TIU("AUDA"))
  1. S TIUZ(1208)=$G(TIU("CSDA"))
  1. S TIUZ(1205)=$G(VLOC)
  1. S TIUZ(1211)=$G(VLOC)
  1. S TIUZ(1212)=$G(TIU("DIVISION"))
  1. S TIUZ(1301)=$G(TIU("RFDT"))
  1. S TIUZ(1302)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA")),TIU("EBDA")=TIUZ(1302)
  1. S TIUZ(1307)=$G(TIU("DICDT"))
  1. S TIUZ(1701)=$G(TIU("SUB"))
  1. ; check if document was found and editable
  1. ; if not editable, make addendum
  1. I +$G(TIUDA),'$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
  1. . N PERSON,SUCCESS
  1. . S PERSON=$G(TIU("AUDA"))
  1. . D MAKEADD^TIUHL7U2(.SUCCESS,TIUDA,.TIUZ,1)
  1. . ; PB - Patch 349 - add comment for consult factor
  1. . 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))
  1. . Q:$G(STOP)=1
  1. . N COMMENT,NOTEDT
  1. . S COMMENT(1)=CFNOTE,NOTEDT=$$NOW^XLFDT,GMRCDA=CONSULTID ; PB - Sep 23 - Patch 356 changed to set GMRCDA to equal CONSULTID instead of VNUM
  1. . D CMT^GMRCGUIB(GMRCDA,.COMMENT,DUZ,NOTEDT,DUZ) ;icr 2980
  1. . 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"))
  1. . D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+SUCCESS) Q
  1. . ; does the ack method below work for CCRA?
  1. ; if editable, make changes to document
  1. I +$G(TIUDA),$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") D Q
  1. . N SUCCESS
  1. . D DELTEXT^TIUPUTPN(TIUDA)
  1. . S TIUZ("HDR")="1^1" D SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ) K TIUZ("HDR"),TIUZ("TEXT")
  1. . 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))
  1. . Q:$G(STOP)=1
  1. . D FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
  1. . 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))
  1. . Q:$G(STOP)=1
  1. . 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"))
  1. . D SIGNDOC^TIUHL7U1(+SUCCESS) I +TIU("EC") ;I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
  1. I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,-1) Q
  1. ; document creation
  1. N SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1,ORIGSTAT
  1. 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
  1. D MAKE^TIUCCRHL7P2(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,$G(TIU("VSTR")))
  1. I $G(TIUDA)>0 D SIGNDOC^TIUCCRHL7P2(+TIUDA) I +TIU("EC") D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA) Q
  1. ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
  1. 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
  1. 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"))
  1. S $P(^TIU(8925,+TIUDA,0),U,7)=$S(+$G(TIU("EPDT")):TIU("EPDT"),+$G(TIU("RFDT")):TIU("RFDT"),1:$$NOW^XLFDT)
  1. ; update the consult as necessary
  1. I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") D
  1. . N TIUSTAT S TIUSTAT=$P($G(^TIU(8925,+TIUDA,0)),U,5)
  1. . S TIUSTAT="INCOMPLETE"
  1. D ACK^TIUCCHL7UT(HL("MID"),TIUNAME,+TIUDA)
  1. D SEND^TIUALRT(+TIUDA)
  1. D AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
  1. Q
  1. MESSAGE(MSGID,VNUM,MSGTEXT) ; Send a MailMan Message with the errors
  1. N DUZ,XMDUZ,XMSUB,XMTEXT,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMZ,XMMG,DATE,J,FLG1,MID
  1. S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. S XMSUB="Consult: "_$G(VNUM)_" TIU CCRA Consult Issue from HSRM"
  1. S MSGTEXT(1)=" "
  1. S MSGTEXT(2)="Error Processing TIU Note for Consult ID: "_$G(VNUM)_" from HSRM"
  1. S MSGTEXT(3)="The error is: "_$G(MSGTEXT)
  1. S MSGTEXT(4)="Date: "_DATE
  1. S MSGTEXT(5)="Message ID: "_MSGID
  1. S XMTEXT="MSGTEXT("
  1. S XMDUZ="TIU CONSULT Transaction Error"
  1. S XMDUZ=.5
  1. S XMY("G.TIU HSRM CONSULT HL7 MESSAGES")=""
  1. D ^XMD
  1. Q