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

TIUHL7P3.m

Go to the documentation of this file.
  1. TIUHL7P3 ; SLC/AJB - TIUHL7 Msg Processing; March 23, 2005
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**200**;Jun 20, 1997
  1. Q
  1. CONTINUE ;
  1. ;
  1. ; DOCUMENT TITLE & VISIT LIMITATION
  1. I '+$$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!'+($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) D TIUVISIT^TIUSRVA(.TIUTMP,TIU("TDA"),$G(DFN),$G(TIU("VSTR"))) I +TIUTMP D
  1. . S TIUDA=+$$EXIST^TIUEDI3(+$G(DFN),+TIU("TDA"),$G(TIU("VSTR")),0,+TIU("AUDA")) I '+TIUDA D ERR^TIUHL7U1("TXA",16,"0000.00",TIU("TITLE")_" already exists for this visit; only one record of this type is allowed per visit.")
  1. ;
  1. ; get document parameters
  1. D DOCPRM^TIUHL7U2(TIU("TDA"),.TIUDPRM)
  1. ;
  1. ; verify upload support for SURGICAL REPORT titles
  1. I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"SURGICAL REPORTS") D
  1. . I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) Q
  1. . D ERR^TIUHL7U1("TXA",16,"0000.00","This SURGICAL REPORT ["_TIU("TITLE")_"] title is not a supported upload title.")
  1. ;
  1. ; send APPLICATION REJECT if any data element verification failed
  1. I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  1. ;
  1. ; validate and process OPERATION REPORTS or PROCEDURE REPORTS
  1. I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"OPERATION REPORTS")!($$MEMBEROF^TIUHL7U1(TIU("TITLE"),"PROCEDURE REPORT (NON-O.R.)")) D Q
  1. . N SUCCESS,TIUD0,TIUDA,TIUDAD,TIUSR0,TIUSRCN,TIUOPDT,TIUSTAT
  1. . S TIUSRCN=+$G(TIU("SRCN")),TIUOPDT=+$P($G(TIU("EPDT")),"."),TIUDA=""
  1. . I '+TIUSRCN,'+TIUOPDT D ERR^TIUHL7U1("TXA",12,"0000.000","HL7 message missing SURGICAL CASE # and OPERATION DATE.")
  1. . I '+TIUSRCN,+TIUOPDT S TIUSRCN=$$FINDCASE^TIUPUTS($G(DFN),TIUOPDT) I '+TIUSRCN D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find a SURGICAL CASE # using the EPISODE BEGIN DATE ["_$$FMTE^XLFDT(TIUOPDT)_"].")
  1. . I +TIUSRCN,$D(^SRF(TIUSRCN,"TIU")) S TIUDA=$$GETSDA^TIUPUTS(TIUSRCN) I '+TIUDA D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
  1. . I +TIUSRCN'>0 D ERR^TIUHL7U1("TXA",12,"0000.000","SURGICAL CASE # cannot be determined.")
  1. . I +TIUDA'>0 D ERR^TIUHL7U1("TXA",12,"0000.000","Unable to find "_TIU("TITLE")_" document stub for SURGICAL CASE #"_TIUSRCN_".")
  1. . I '+TIU("EC") D
  1. . . S TIUD0=$G(^TIU(8925,TIUDA,0)),TIUSR0=$G(^SRF(TIUSRCN,0))
  1. . . I '+TIUOPDT S TIU("EPDT")=$P($P(TIUSR0,U,9),"."),TIUOPDT=TIU("EPDT")
  1. . . I +TIUSR0'=$G(DFN) D ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$G(DFN),.01)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$GET1^DIQ(2,+TIUSR0,.01)_"].")
  1. . . I +$P(TIUD0,U,2)'=$G(DFN) D ERR^TIUHL7U1("TXA",12,"0000.000","PATIENT mismatch between HL7 message ["_$$GET1^DIQ(2,$G(DFN),.01)_"] and "_TIU("TITLE")_" stub ["_$$GET1^DIQ(2,+$P(TIUD0,U,2),.01)_"].")
  1. . . I TIUOPDT'=$P($P(TIUSR0,U,9),".") D ERR^TIUHL7U1("TXA",12,"0000.000","OPERATION DATE mismatch between HL7 message ["_$$FMTE^XLFDT(TIUOPDT)_"] and SURGICAL CASE #"_TIUSRCN_" ["_$$FMTE^XLFDT($P($P(TIUSR0,U,9),"."))_"].") Q
  1. . . I +TIU("EC") Q
  1. . . I +$G(TIUDA),'$$CANEDIT^TIUHL7U1(TIUDA),'+TIU("EC") G MAKEADD
  1. . . S TIUZ("HDR")="1^1" D SETTEXT^TIUSRVPT(.SUCCESS,+TIUDA,.TIUZ)
  1. . . I '+$G(SUCCESS) D ERR^TIUHL7U1("OBX",1,"0000.00","DOCUMENT TEXT failed to update.")
  1. . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  1. . D FOLLOWUP^TIUPUTS(+TIUDA)
  1. . S $P(^TIU(8925,+TIUDA,13),U,2)=$S(+$G(TIU("EBDA")):TIU("EBDA"),1:TIU("AUDA"))
  1. . D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  1. . D ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
  1. ;
  1. MAKEADD ;
  1. ; validate CONSULT title
  1. I $$MEMBEROF^TIUHL7U1(TIU("TITLE"),"CONSULTS") D
  1. . I '+$G(TIU("CNCN")) D ERR^TIUHL7U1("TXA",12,"0000.00","HL7 message missing CONSULT #.") Q
  1. . I '$$CPPAT^GMRCCP(TIU("CNCN"),$G(DFN)) D ERR^TIUHL7U1("TXA",12,"0000.00","PATIENT NAME ["_TIU("PTNAME")_"] mismatch between HL7 message and CONSULT ["_$$GET1^DIQ(123,TIU("CNCN"),.02)_"].") Q
  1. . S TIUZ(1405)=TIU("CNCN")_";GMR(123,"
  1. ;
  1. I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  1. ;
  1. ; set data fields
  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. ;
  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(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. ;
  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. . I '+SUCCESS D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
  1. . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  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^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
  1. . D ACK^TIUHL7U1("AA",TIUNAME,SUCCESS),SEND^TIUALRT(SUCCESS),SENDADD^TIUALRT(+TIUDA)
  1. ;
  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 D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
  1. . D FILE^TIUSRVP(.SUCCESS,+TIUDA,.TIUZ)
  1. . I '+SUCCESS D ERR^TIUHL7U1("TIU",1,"0000.000",$P(SUCCESS,U,2))
  1. . I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  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^TIUHL7U1("AR",TIUNAME,+SUCCESS) Q
  1. . D ACK^TIUHL7U1("AA",TIUNAME,TIUDA),SEND^TIUALRT(TIUDA) Q
  1. ;
  1. I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,-1) Q
  1. ;
  1. ; document creation
  1. N SDCNT,TIUDIV1,TIUFPRIV,TIUPRM0,TIUPRM1
  1. D MAKE^TIUSRVP(.TIUDA,DFN,TIU("TDA"),,,,.TIUZ,TIU("VSTR"))
  1. ;
  1. ; verify creation & and set capture method to UPLOAD & ENTERED BY (if applicable)
  1. I '+TIUDA D ERR^TIUHL7U1("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. ;
  1. ; process signature/co-signature
  1. D SIGNDOC^TIUHL7U1(+TIUDA) I +TIU("EC") D ACK^TIUHL7U1("AR",TIUNAME,+TIUDA) Q
  1. ;
  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=$S(TIUSTAT>6:"COMPLETED",1:"INCOMPLETE")
  1. . D GET^GMRCTIU(TIU("CNCN"),+TIUDA,TIUSTAT,TIU("AUDA"))
  1. ;
  1. D ACK^TIUHL7U1("AA",TIUNAME,+TIUDA)
  1. D SEND^TIUALRT(+TIUDA)
  1. D AUDIT^TIUHL7U1(+TIUDA,0,$$CHKSUM^TIULC("^TIU(8925,"_+TIUDA_",""TEXT"")"))
  1. ;
  1. Q