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.
TIUCCRHL7P3 ; CCRA/PB - TIUHL7 Msg Processing; March 23, 2005
 ;;1.0;TEXT INTEGRATION UTILITIES;**337,344**;Jun 20, 1997;Build 11
 ; Documented API's and Integration Agreements
 ; ----------------------------------------------
 ; IA #3473I  GET^GMRCTIU
 ;PB - Patch 344 to modify how the note and addendum text is formatted
 ;
 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(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)
 . I '+SUCCESS S MSGTEXT=$P(SUCCESS,U,2),STOP=1 D MESSAGE(MSGID,$G(VNUM),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(VNUM)) ;D ERR^TIUCCHL7UT("TIU",1,"0000.000",$P(SUCCESS,U,2))
 . Q:$G(STOP)=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"))
 . 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(VNUM),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(VNUM)) ;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(VNUM),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(VNUM)) ;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,VNUM_",",8,"I")   ;save the status of the consult before adding the note.
 ;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,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(VNUM),MSGTEXT),ANAK^TIUCCHL7UT(MSGID,$G(MSGTEXT),$G(VNUM)) 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
 ;