- 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 Feb 19, 2025@00:09:48 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