source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGHTHLAA.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1DGHTHLAA ;ALB/JRC - Home Telehealth Patient HL7 Application Acknowledgment;10 January 2005 ; 10/4/06 3:07pm
2 ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
3 ;;
4ACKMSG ; Process A03 and A04 'AA' messages for Home Telehealth Application
5 ; Input : All variables set by the HL7 package
6 ; Output : None
7 ;
8 ; Note: This process will update file # 391.31 subfile 391.317
9 ; Date/Time of ACK from HT - Field .06
10 ; ACK Code from HT - Field .07
11 ; Reject Message(Only if reject) - Field .08
12 ;
13 N DGHMSG,DGHPARAM,I,X
14 ;
15 ;Get message text
16 S ^TMP("DGRUACK",$H)="START PROCESS"
17 F I=1:1 X HLNEXT Q:(HLQUIT'>0) D
18 . S DGHMSG(I,1)=HLNODE
19 . ; Check for segment length greater than 245
20 . S X=0 F S X=+$O(HLNODE(X)) Q:('X) S DGHMSG(I,(X+1))=HLNODE(X)
21 ;
22 ;Quit if there is no valid message header
23 Q:$P($G(DGHMSG(1,1)),"^")'="MSH"
24 ;
25 M ^TMP("DGRUACK",$H,"HL")=DGHMSG
26 ;analyze the message and take appropriate action
27 ;
28 S X=1,DGHPARAM=""
29 F S X=+$O(DGHMSG(X)) Q:('X) D
30 . I $P(DGHMSG(X,1),"^")="MSA" D
31 .. D PROCESS(DGHMSG(X,1),.DGHPARAM)
32 Q
33 ;
34PROCESS(DGHMSG,DGHPARAM) ;
35 N EVNTYPE,ACK,REJMSG,MSGID,IEN,SIEN,PATIENT,FLDS,DGHERR,DGHFDA,DATE
36 ;Initialize variables
37 S EVNTYPE=""
38 ;
39 ;Set incoming message event type
40 S EVNTYPE=$G(HL("ETN"))
41 ;
42 Q:$G(DGHMSG)']""
43 ;
44 S ACK=$P(DGHMSG,"^",2) ; Get acknowledgement code
45 S REJMSG=$P(DGHMSG,"^",7) ; Get Reject Message if it exist
46 ;
47 ;Get outgoing message ID
48 S MSGID=$P(DGHMSG,U,3)
49 ;
50 ;Update Home Telehealth File (# 391.31) sub-file (#391.317)
51 ;$order on "D" cross reference to resolve IEN and SIEN values
52 ;for updating the record and sub record
53 ;
54 S IEN=0,IEN=$O(^DGHT(391.31,"D",MSGID,IEN)) Q:'+IEN
55 S SIEN=0,SIEN=$O(^DGHT(391.31,"D",MSGID,IEN,SIEN)) Q:'+SIEN
56 Q:$P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,7)="A"
57 ;Resolve external value for PATIENT
58 S PATIENT=$$GET1^DIQ(2,$P($G(^DGHT(391.31,IEN,0)),U,2),.01,"E")
59 S FLDS=SIEN_","_IEN_","
60 ;If valid entries found update subfile 391.317
61 I IEN&SIEN D
62 .;Convert date to FM format
63 .S DATE=$$FMTE^XLFDT($$FMDATE^HLFNC($P(HL("DTM"),"-",1)))
64 .S DGHFDA(391.317,FLDS,.06)=DATE
65 .S DGHFDA(391.317,FLDS,.07)=$S(ACK="AA":"A",ACK="AR":"R",1:"")
66 .S DGHFDA(391.317,FLDS,.08)=$P(REJMSG,"~",2)
67 .D FILE^DIE("EK","DGHFDA","DGHERR")
68 .I $D(DGHERR) S DGHERR="Problem encountered while filing record # "_IEN
69 ;
70 ;If valid AA is receieved for message kill the "HTHNOACK" xref
71 D:(ACK="AA")!(ACK="AR") KILLXREF^DGHTXREF(MSGID)
72 ;
73 ;Update inactivation date field (#6)
74 I $P($G(^DGHT(391.31,IEN,"TRAN",SIEN,0)),U,4)="I",ACK="AA",'$D(DGHERR) D
75 .N FLDS S FLDS=IEN_","
76 .S DGHFDA(391.31,FLDS,6)=DATE
77 .D FILE^DIE("EK","DGHFDA","DGHERR")
78 ;
79 ;If the ACK is AA and 'DGHERR quit
80 Q:ACK="AA"&'$D(DGHERR)
81 ;
82 ;If transaction is not found in subfile #391.317 set DGHERR variable
83 I '+SIEN S DGHERR="Problem processing transaction record"
84 ;
85 ;Set DGHPARAM(4) to error message if defined
86 S DGHPARAM(4)=$S($D(DGHERR):DGHERR,ACK'="AA":$P(DGHMSG,"^",7),1:"")
87 ;
88 D MESSAGE
89 Q
90 ;
91MESSAGE ;Build bulletin and send to mail group
92 ; Input:
93 ; Output:
94 ;
95 N MSGTEXT,XMTEXT,XMSUB,XMY,XMCHAN,XMZ,XMDUZ,MSGTYPE
96 S MSGTYPE=$S(EVNTYPE["A04":"Sign-up/Activation",EVNTYPE["A03":"Inactivation",1:"")
97 S MSGTEXT(1)=" "
98 S MSGTEXT(2)="Home Telehealth "_MSGTYPE_" was REJECTED"
99 S MSGTEXT(3)=" "
100 S MSGTEXT(4)="Date: "_$$FMTE^XLFDT(DATE,1)
101 S MSGTEXT(5)="Patient: "_PATIENT
102 S MSGTEXT(6)="Message ID: "_MSGID
103 S MSGTEXT(7)="Error Code: "_DGHPARAM(4)
104 ;Send message to mail group
105 S XMSUB="Home Telehealth Patient "_MSGTYPE_" Reject"
106 S XMTEXT="MSGTEXT("
107 S XMY("G.DGHTERR")=""
108 S XMCHAN=1
109 S XMDUZ="Home Telehealth Patient "_MSGTYPE
110 D ^XMD
111 Q
Note: See TracBrowser for help on using the repository browser.