DGHTHLAA ;ALB/JRC - Home Telehealth Patient HL7 Application Acknowledgment;10 January 2005 ; 10/4/06 3:07pm
;;5.3;Registration;**644**;Aug 13, 1993;Build 11
;;
ACKMSG ; Process A03 and A04 'AA' messages for Home Telehealth Application
; Input : All variables set by the HL7 package
; Output : None
;
; Note: This process will update file # 391.31 subfile 391.317
; Date/Time of ACK from HT - Field .06
; ACK Code from HT - Field .07
; Reject Message(Only if reject) - Field .08
;
N DGHMSG,DGHPARAM,I,X
;
;Get message text
S ^TMP("DGRUACK",$H)="START PROCESS"
F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
. S DGHMSG(I,1)=HLNODE
. ; Check for segment length greater than 245
. S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGHMSG(I,(X+1))=HLNODE(X)
;
;Quit if there is no valid message header
Q:$P($G(DGHMSG(1,1)),"^")'="MSH"
;
M ^TMP("DGRUACK",$H,"HL")=DGHMSG
;analyze the message and take appropriate action
;
S X=1,DGHPARAM=""
F S X=+$O(DGHMSG(X)) Q:('X) D
. I $P(DGHMSG(X,1),"^")="MSA" D
.. D PROCESS(DGHMSG(X,1),.DGHPARAM)
Q
;
PROCESS(DGHMSG,DGHPARAM) ;
N EVNTYPE,ACK,REJMSG,MSGID,IEN,SIEN,PATIENT,FLDS,DGHERR,DGHFDA,DATE
;Initialize variables
S EVNTYPE=""
;
;Set incoming message event type
S EVNTYPE=$G(HL("ETN"))
;
Q:$G(DGHMSG)']""
;
S ACK=$P(DGHMSG,"^",2) ; Get acknowledgement code
S REJMSG=$P(DGHMSG,"^",7) ; Get Reject Message if it exist
;
;Get outgoing message ID
S MSGID=$P(DGHMSG,U,3)
;
;Update Home Telehealth File (# 391.31) sub-file (#391.317)
;$order on "D" cross reference to resolve IEN and SIEN values
;for updating the record and sub record
;
S IEN=0,IEN=$O(^DGHT(391.31,"D",MSGID,IEN)) Q:'+IEN
S SIEN=0,SIEN=$O(^DGHT(391.31,"D",MSGID,IEN,SIEN)) Q:'+SIEN
Q:$P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,7)="A"
;Resolve external value for PATIENT
S PATIENT=$$GET1^DIQ(2,$P($G(^DGHT(391.31,IEN,0)),U,2),.01,"E")
S FLDS=SIEN_","_IEN_","
;If valid entries found update subfile 391.317
I IEN&SIEN D
.;Convert date to FM format
.S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
.S DGHFDA(391.317,FLDS,.06)=DATE
.S DGHFDA(391.317,FLDS,.07)=$S(ACK="AA":"A",ACK="AR":"R",1:"")
.S DGHFDA(391.317,FLDS,.08)=$P(REJMSG,"~",2)
.D FILE^DIE("EK","DGHFDA","DGHERR")
.I $D(DGHERR) S DGHERR="Problem encountered while filing record # "_IEN
;
;If valid AA is receieved for message kill the "HTHNOACK" xref
D:(ACK="AA")!(ACK="AR") KILLXREF^DGHTXREF(MSGID)
;
;Update inactivation date field (#6)
I $P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,4)="I",ACK="AA",'$D(DGHERR) D
.N FLDS S FLDS=IEN_","
.S DGHFDA(391.31,FLDS,6)=DATE
.D FILE^DIE("EK","DGHFDA","DGHERR")
;
;If the ACK is AA and 'DGHERR quit
Q:ACK="AA"&'$D(DGHERR)
;
;If transaction is not found in subfile #391.317 set DGHERR variable
I '+SIEN S DGHERR="Problem processing transaction record"
;
;Set DGHPARAM(4) to error message if defined
S DGHPARAM(4)=$S($D(DGHERR):DGHERR,ACK'="AA":$P(DGHMSG,"^",7),1:"")
;
D MESSAGE
Q
;
MESSAGE ;Build bulletin and send to mail group
; Input:
; Output:
;
N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ,MSGTYPE
S MSGTYPE=$S(EVNTYPE["A04":"Sign-up/Activation",EVNTYPE["A03":"Inactivation",1:"")
S MSGTEXT(1)=" "
S MSGTEXT(2)="Home Telehealth "_MSGTYPE_" was REJECTED"
S MSGTEXT(3)=" "
S MSGTEXT(4)="Date: "_$$FMTE^XLFDT(DATE,1)
S MSGTEXT(5)="Patient: "_PATIENT
S MSGTEXT(6)="Message ID: "_MSGID
S MSGTEXT(7)="Error Code: "_DGHPARAM(4)
;Send message to mail group
S XMSUB="Home Telehealth Patient "_MSGTYPE_" Reject"
S XMTEXT="MSGTEXT("
S XMY("G.DGHTERR")=""
S XMCHAN=1
S XMDUZ="Home Telehealth Patient "_MSGTYPE
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGHTHLAA 3801 printed Sep 23, 2025@20:19:37 Page 2
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
+2 ;;
ACKMSG ; Process A03 and A04 'AA' messages for Home Telehealth Application
+1 ; Input : All variables set by the HL7 package
+2 ; Output : None
+3 ;
+4 ; Note: This process will update file # 391.31 subfile 391.317
+5 ; Date/Time of ACK from HT - Field .06
+6 ; ACK Code from HT - Field .07
+7 ; Reject Message(Only if reject) - Field .08
+8 ;
+9 NEW DGHMSG,DGHPARAM,I,X
+10 ;
+11 ;Get message text
+12 SET ^TMP("DGRUACK",$HOROLOG)="START PROCESS"
+13 FOR I=1:1
XECUTE HLNEXT
if (HLQUIT'>0)
QUIT
Begin DoDot:1
+14 SET DGHMSG(I,1)=HLNODE
+15 ; Check for segment length greater than 245
+16 SET X=0
FOR
SET X=+$ORDER(HLNODE(X))
if ('X)
QUIT
SET DGHMSG(I,(X+1))=HLNODE(X)
End DoDot:1
+17 ;
+18 ;Quit if there is no valid message header
+19 if $PIECE($GET(DGHMSG(1,1)),"^")'="MSH"
QUIT
+20 ;
+21 MERGE ^TMP("DGRUACK",$HOROLOG,"HL")=DGHMSG
+22 ;analyze the message and take appropriate action
+23 ;
+24 SET X=1
SET DGHPARAM=""
+25 FOR
SET X=+$ORDER(DGHMSG(X))
if ('X)
QUIT
Begin DoDot:1
+26 IF $PIECE(DGHMSG(X,1),"^")="MSA"
Begin DoDot:2
+27 DO PROCESS(DGHMSG(X,1),.DGHPARAM)
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
PROCESS(DGHMSG,DGHPARAM) ;
+1 NEW EVNTYPE,ACK,REJMSG,MSGID,IEN,SIEN,PATIENT,FLDS,DGHERR,DGHFDA,DATE
+2 ;Initialize variables
+3 SET EVNTYPE=""
+4 ;
+5 ;Set incoming message event type
+6 SET EVNTYPE=$GET(HL("ETN"))
+7 ;
+8 if $GET(DGHMSG)']""
QUIT
+9 ;
+10 ; Get acknowledgement code
SET ACK=$PIECE(DGHMSG,"^",2)
+11 ; Get Reject Message if it exist
SET REJMSG=$PIECE(DGHMSG,"^",7)
+12 ;
+13 ;Get outgoing message ID
+14 SET MSGID=$PIECE(DGHMSG,U,3)
+15 ;
+16 ;Update Home Telehealth File (# 391.31) sub-file (#391.317)
+17 ;$order on "D" cross reference to resolve IEN and SIEN values
+18 ;for updating the record and sub record
+19 ;
+20 SET IEN=0
SET IEN=$ORDER(^DGHT(391.31,"D",MSGID,IEN))
if '+IEN
QUIT
+21 SET SIEN=0
SET SIEN=$ORDER(^DGHT(391.31,"D",MSGID,IEN,SIEN))
if '+SIEN
QUIT
+22 if $PIECE($GET(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,7)="A"
QUIT
+23 ;Resolve external value for PATIENT
+24 SET PATIENT=$$GET1^DIQ(2,$PIECE($GET(^DGHT(391.31,IEN,0)),U,2),.01,"E")
+25 SET FLDS=SIEN_","_IEN_","
+26 ;If valid entries found update subfile 391.317
+27 IF IEN&SIEN
Begin DoDot:1
+28 ;Convert date to FM format
+29 SET DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($PIECE(HL("DTM"),"-",1)))
+30 SET DGHFDA(391.317,FLDS,.06)=DATE
+31 SET DGHFDA(391.317,FLDS,.07)=$SELECT(ACK="AA":"A",ACK="AR":"R",1:"")
+32 SET DGHFDA(391.317,FLDS,.08)=$PIECE(REJMSG,"~",2)
+33 DO FILE^DIE("EK","DGHFDA","DGHERR")
+34 IF $DATA(DGHERR)
SET DGHERR="Problem encountered while filing record # "_IEN
End DoDot:1
+35 ;
+36 ;If valid AA is receieved for message kill the "HTHNOACK" xref
+37 if (ACK="AA")!(ACK="AR")
DO KILLXREF^DGHTXREF(MSGID)
+38 ;
+39 ;Update inactivation date field (#6)
+40 IF $PIECE($GET(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,4)="I"
IF ACK="AA"
IF '$DATA(DGHERR)
Begin DoDot:1
+41 NEW FLDS
SET FLDS=IEN_","
+42 SET DGHFDA(391.31,FLDS,6)=DATE
+43 DO FILE^DIE("EK","DGHFDA","DGHERR")
End DoDot:1
+44 ;
+45 ;If the ACK is AA and 'DGHERR quit
+46 if ACK="AA"&'$DATA(DGHERR)
QUIT
+47 ;
+48 ;If transaction is not found in subfile #391.317 set DGHERR variable
+49 IF '+SIEN
SET DGHERR="Problem processing transaction record"
+50 ;
+51 ;Set DGHPARAM(4) to error message if defined
+52 SET DGHPARAM(4)=$SELECT($DATA(DGHERR):DGHERR,ACK'="AA":$PIECE(DGHMSG,"^",7),1:"")
+53 ;
+54 DO MESSAGE
+55 QUIT
+56 ;
MESSAGE ;Build bulletin and send to mail group
+1 ; Input:
+2 ; Output:
+3 ;
+4 NEW MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ,MSGTYPE
+5 SET MSGTYPE=$SELECT(EVNTYPE["A04":"Sign-up/Activation",EVNTYPE["A03":"Inactivation",1:"")
+6 SET MSGTEXT(1)=" "
+7 SET MSGTEXT(2)="Home Telehealth "_MSGTYPE_" was REJECTED"
+8 SET MSGTEXT(3)=" "
+9 SET MSGTEXT(4)="Date: "_$$FMTE^XLFDT(DATE,1)
+10 SET MSGTEXT(5)="Patient: "_PATIENT
+11 SET MSGTEXT(6)="Message ID: "_MSGID
+12 SET MSGTEXT(7)="Error Code: "_DGHPARAM(4)
+13 ;Send message to mail group
+14 SET XMSUB="Home Telehealth Patient "_MSGTYPE_" Reject"
+15 SET XMTEXT="MSGTEXT("
+16 SET XMY("G.DGHTERR")=""
+17 SET XMCHAN=1
+18 SET XMDUZ="Home Telehealth Patient "_MSGTYPE
+19 DO ^XMD
+20 QUIT
