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

DGHTHLAA.m

Go to the documentation of this file.
  1. DGHTHLAA ;ALB/JRC - Home Telehealth Patient HL7 Application Acknowledgment;10 January 2005 ; 10/4/06 3:07pm
  1. ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
  1. ;;
  1. ACKMSG ; Process A03 and A04 'AA' messages for Home Telehealth Application
  1. ; Input : All variables set by the HL7 package
  1. ; Output : None
  1. ;
  1. ; Note: This process will update file # 391.31 subfile 391.317
  1. ; Date/Time of ACK from HT - Field .06
  1. ; ACK Code from HT - Field .07
  1. ; Reject Message(Only if reject) - Field .08
  1. ;
  1. N DGHMSG,DGHPARAM,I,X
  1. ;
  1. ;Get message text
  1. S ^TMP("DGRUACK",$H)="START PROCESS"
  1. F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
  1. . S DGHMSG(I,1)=HLNODE
  1. . ; Check for segment length greater than 245
  1. . S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGHMSG(I,(X+1))=HLNODE(X)
  1. ;
  1. ;Quit if there is no valid message header
  1. Q:$P($G(DGHMSG(1,1)),"^")'="MSH"
  1. ;
  1. M ^TMP("DGRUACK",$H,"HL")=DGHMSG
  1. ;analyze the message and take appropriate action
  1. ;
  1. S X=1,DGHPARAM=""
  1. F S X=+$O(DGHMSG(X)) Q:('X) D
  1. . I $P(DGHMSG(X,1),"^")="MSA" D
  1. .. D PROCESS(DGHMSG(X,1),.DGHPARAM)
  1. Q
  1. ;
  1. PROCESS(DGHMSG,DGHPARAM) ;
  1. N EVNTYPE,ACK,REJMSG,MSGID,IEN,SIEN,PATIENT,FLDS,DGHERR,DGHFDA,DATE
  1. ;Initialize variables
  1. S EVNTYPE=""
  1. ;
  1. ;Set incoming message event type
  1. S EVNTYPE=$G(HL("ETN"))
  1. ;
  1. Q:$G(DGHMSG)']""
  1. ;
  1. S ACK=$P(DGHMSG,"^",2) ; Get acknowledgement code
  1. S REJMSG=$P(DGHMSG,"^",7) ; Get Reject Message if it exist
  1. ;
  1. ;Get outgoing message ID
  1. S MSGID=$P(DGHMSG,U,3)
  1. ;
  1. ;Update Home Telehealth File (# 391.31) sub-file (#391.317)
  1. ;$order on "D" cross reference to resolve IEN and SIEN values
  1. ;for updating the record and sub record
  1. ;
  1. S IEN=0,IEN=$O(^DGHT(391.31,"D",MSGID,IEN)) Q:'+IEN
  1. S SIEN=0,SIEN=$O(^DGHT(391.31,"D",MSGID,IEN,SIEN)) Q:'+SIEN
  1. Q:$P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,7)="A"
  1. ;Resolve external value for PATIENT
  1. S PATIENT=$$GET1^DIQ(2,$P($G(^DGHT(391.31,IEN,0)),U,2),.01,"E")
  1. S FLDS=SIEN_","_IEN_","
  1. ;If valid entries found update subfile 391.317
  1. I IEN&SIEN D
  1. .;Convert date to FM format
  1. .S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
  1. .S DGHFDA(391.317,FLDS,.06)=DATE
  1. .S DGHFDA(391.317,FLDS,.07)=$S(ACK="AA":"A",ACK="AR":"R",1:"")
  1. .S DGHFDA(391.317,FLDS,.08)=$P(REJMSG,"~",2)
  1. .D FILE^DIE("EK","DGHFDA","DGHERR")
  1. .I $D(DGHERR) S DGHERR="Problem encountered while filing record # "_IEN
  1. ;
  1. ;If valid AA is receieved for message kill the "HTHNOACK" xref
  1. D:(ACK="AA")!(ACK="AR") KILLXREF^DGHTXREF(MSGID)
  1. ;
  1. ;Update inactivation date field (#6)
  1. I $P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,4)="I",ACK="AA",'$D(DGHERR) D
  1. .N FLDS S FLDS=IEN_","
  1. .S DGHFDA(391.31,FLDS,6)=DATE
  1. .D FILE^DIE("EK","DGHFDA","DGHERR")
  1. ;
  1. ;If the ACK is AA and 'DGHERR quit
  1. Q:ACK="AA"&'$D(DGHERR)
  1. ;
  1. ;If transaction is not found in subfile #391.317 set DGHERR variable
  1. I '+SIEN S DGHERR="Problem processing transaction record"
  1. ;
  1. ;Set DGHPARAM(4) to error message if defined
  1. S DGHPARAM(4)=$S($D(DGHERR):DGHERR,ACK'="AA":$P(DGHMSG,"^",7),1:"")
  1. ;
  1. D MESSAGE
  1. Q
  1. ;
  1. MESSAGE ;Build bulletin and send to mail group
  1. ; Input:
  1. ; Output:
  1. ;
  1. N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ,MSGTYPE
  1. S MSGTYPE=$S(EVNTYPE["A04":"Sign-up/Activation",EVNTYPE["A03":"Inactivation",1:"")
  1. S MSGTEXT(1)=" "
  1. S MSGTEXT(2)="Home Telehealth "_MSGTYPE_" was REJECTED"
  1. S MSGTEXT(3)=" "
  1. S MSGTEXT(4)="Date: "_$$FMTE^XLFDT(DATE,1)
  1. S MSGTEXT(5)="Patient: "_PATIENT
  1. S MSGTEXT(6)="Message ID: "_MSGID
  1. S MSGTEXT(7)="Error Code: "_DGHPARAM(4)
  1. ;Send message to mail group
  1. S XMSUB="Home Telehealth Patient "_MSGTYPE_" Reject"
  1. S XMTEXT="MSGTEXT("
  1. S XMY("G.DGHTERR")=""
  1. S XMCHAN=1
  1. S XMDUZ="Home Telehealth Patient "_MSGTYPE
  1. D ^XMD
  1. Q