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

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

initial load of WorldVistAEHR

File size: 7.0 KB
Line 
1DGENUPL3 ;ALB/CJM,ISA/KWP,AEG,BRM,TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 9/29/06 12:51pm
2 ;;5.3;REGISTRATION;**147,230,232,377,404,451,653**;Aug 13,1993;Build 2
3 ;
4 ;
5ADDMSG(MSGS,MESSAGE,TOHEC) ;
6 ;Description: Used to add a message to an array of messages to be sent.
7 ;
8 ;Input:
9 ; MSGS - the array to store the message (pass by reference)
10 ; MESSAGE - the message to store
11 ; TOHEC - a flag, if set to 1 it means that HEC should also receive notification
12 ;
13 ;Output: none
14 ;
15 I MESSAGE["DATE OF DEATH" Q
16 S MSGS(0)=($G(MSGS(0))+1)
17 S MSGS(MSGS(0))=MESSAGE
18 I ($G(TOHEC)=1) S MSGS("HEC")=1
19 Q
20 ;
21 ;
22NOTIFY(DGPAT,MSGS) ;
23 ;Description: This is used to send a message to the local mail group
24 ;defined by the MAS Parameter ELIGIBILITY UPLOAD MAIL GROUP.The
25 ;notification is to be used when specific problems or conditions
26 ;regarding the upload of the enrollment or eligibility data.
27 ;
28 ;Input:
29 ; OLDPAT -used if the DGPAT elements have not been built
30 ; DGPAT - patient array (pass by reference)
31 ; MSGS - the an array of messages that should be included in the
32 ; notification (pass by reference). If MSGS("HEC")=1
33 ; it means that HEC should also receive notification.
34 ;
35 ;Output: none
36 ;
37 N TEXT,XMDUZ,XMTEXT,XMSUB,XMSTRIP,XMROU,XMY,XMZ,XMDF,COUNT
38 N HEADER,NSC,POW,TMPSTR,MAILGRP,ELIG,CD
39 ;
40 ;if there are no alerts, then quit
41 Q:'$G(MSGS(0))
42 ;
43 ;Get reason for alert. If there is more than one reason decide which
44 ;reason to display. 'NON-SERVICE' alerts have a higher priority than
45 ;other alerts and are therefore displayed before other alerts in the
46 ;subject line, followed by 'POW' alerts in priority.
47 S (ELIG,NSC,POW,CD)=0
48 S COUNT=0 F S COUNT=$O(MSGS(COUNT)) Q:'COUNT!NSC D
49 .I MSGS(COUNT)["PREVIOUSLY ELIGIBLE" S ELIG=1 Q
50 .I MSGS(COUNT)["NON-SERVICE" S NSC=1 Q
51 .I MSGS(COUNT)["POW" S POW=1 Q
52 .I MSGS(COUNT)["CD EVALUATION" S CD=1 Q
53 .S HEADER=MSGS(COUNT)
54 .Q
55 D
56 .I ELIG S HEADER="Ineligibility Alert: " Q
57 .I NSC S HEADER="NSC Alert: " Q
58 .I POW&'NSC S HEADER="POW Alert: " Q
59 .I CD S HEADER="CD Alert: " Q
60 .Q
61 ;
62 S XMDF=""
63 S (XMDUN,XMDUZ)="Registration Enrollment Module"
64 ;Phase II Re-Enrollment
65 ;DGPAT("SSN") is built by the parser. DGPAT("NAME"),DGPAT("SEX"),DGPAT("DOB")(are merged into DGPAT from OLDPAT.
66 ;The checks below are to setup the DGPAT elements from OLDPAT if NOTIFY is called before the merge.
67 I '$D(DGPAT("NAME")) S DGPAT("NAME")=$G(OLDPAT("NAME"))
68 I '$D(DGPAT("SEX")) S DGPAT("SEX")=$G(OLDPAT("SEX"))
69 I '$D(DGPAT("DOB")) S DGPAT("DOB")=$G(OLDPAT("DOB"))
70 S TMPSTR=" ("_$E(DGPAT("NAME"),1,1)
71 S TMPSTR=TMPSTR_$E(DGPAT("SSN"),$L(DGPAT("SSN"))-3,1000)_")"
72 S XMSUB=$E(HEADER,1,30)_$E(DGPAT("NAME"),1,25)_TMPSTR
73 ;
74 ; send msg to local mail group specified in IVM SITE PARAMETER file
75 S MAILGRP=+$P($G(^IVM(301.9,1,0)),"^",9)
76 S MAILGRP=$$EXTERNAL^DILFD(301.9,.09,"F",MAILGRP)
77 I MAILGRP]"" S XMY("G."_MAILGRP)=""
78 ;
79 ; if flag is set, send msg to remote mail group specified in
80 ; the IVM SITE PARAMETER file
81 I $G(MSGS("HEC"))=1 D
82 .S MAILGRP=$P($G(^IVM(301.9,1,0)),"^",10)
83 .S MAILGRP=$$EXTERNAL^DILFD(301.9,.10,"F",MAILGRP)
84 .I MAILGRP]"" S XMY("G."_MAILGRP)=""
85 ;
86 ;
87 S XMTEXT="TEXT("
88 S TEXT(1)="The enrollment/eligibility upload produced the following alerts:"
89 S TEXT(2)=" "
90 S TEXT(3)="Patient Name : "_DGPAT("NAME")
91 S TEXT(4)="SSN : "_DGPAT("SSN")
92 S TEXT(5)="DOB : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("DOB"),"F",DGPAT("DOB"))
93 S TEXT(6)="SEX : "_$$EXTERNAL^DILFD(2,$$FIELD^DGENPTA1("SEX"),"F",DGPAT("SEX"))
94 S TEXT(7)=" "
95 ;
96 S TEXT(8)=" ** Alerts **"
97 S TEXT(9)=" "
98 S COUNT=0 F S COUNT=$O(MSGS(COUNT)) Q:'COUNT S TEXT(10+COUNT)=COUNT_") "_MSGS(COUNT)
99 ;
100 D ^XMD
101 Q
102 ;
103BEGUPLD(DFN) ;
104 ;Description: Sets a lock used to determine if an eligibility/enrollment
105 ;upload is in progress.
106 ;
107 ;Input:
108 ; DFN - ien, Patient record
109 ;
110 ;Output:
111 ; Function value - returns 1 if the lock was obtained, 0 otherwise.
112 ;
113 Q:'$G(DFN) 1
114 L +^DGEN("ELIGIBILITY UPLOAD",DFN):3
115 Q $T
116 ;
117ENDUPLD(DFN) ;
118 ;Description: Releases the lock obtained by calling $$BEGUPLD(DFN)
119 ;
120 Q:'$G(DFN)
121 L -^DGEN("ELIGIBILITY UPLOAD",DFN)
122 Q
123 ;
124CKUPLOAD(DFN) ;
125 ;Description: Checks if an upload is in progress. If so, it pauses
126 ;until it is completed.
127 ;The enrollment/eligibility upload can take a while to accomplish.
128 ;If the lock is not obtained initially, it is assumed that the upload
129 ;is in progress, and a message is displayed to the user.
130 ;
131 ;Input: DFN
132 ;Output: none
133 ;
134 N I
135 I '$$BEGUPLD(DFN) D
136 .W !!,"Upload of patient enrollment/eligibility data is in progress ..."
137 .D UNLOCK^DGENPTA1(DFN)
138 .F I=1:1:50 Q:$$BEGUPLD(DFN) W "."
139 .W !,"Upload of patient enrollment/eligibility data is completed.",!
140 D ENDUPLD(DFN)
141 Q
142 ;
143 ;ZMH code moved here from DGENUPL2 - DG*5.3*653
144ZMH ;Purple Heart, POW, OEF/OIF Conflict Loc
145 ;ONLY PROCESS PH, OEF/OIF & POW FROM ZMH
146 Q:$S(SEG(2)="PH":0,SEG(2)="OEIF":0,SEG(2)="POW":0,1:1)
147 I SEG(2)="PH" D Q ;Process Purple Heart from ZMH
148 . S DGPAT("PHI")=$P(SEG(3),$E(HLECH))
149 . S DGELG("PH")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))
150 . S DGPAT("PHST")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2))
151 . S DGPAT("PHRR")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),3))
152 ;
153 I SEG(2)="OEIF" D Q
154 . S DGOEIF("COUNT")=$G(DGOEIF("COUNT"))+1
155 . S DGOEIF("LOC",DGOEIF("COUNT"))=$E($P(SEG(3),$E(HLECH)),1,3)
156 . S DGOEIF("SITE",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2),"INSTITUTION")
157 . S DGOEIF("FR",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE")
158 . S DGOEIF("TO",DGOEIF("COUNT"))=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE")
159 . S DGOEIF("LOCK")=1
160 ;
161 I SEG(2)="POW" D ;Process POW from ZMH
162 . S DGPAT("POWI")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH))) ;POW STATUS INDICATED
163 . S DGELG("POW")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH)))
164 . S DGPAT("POWLOC")=$$CONVERT^DGENUPL1($P(SEG(3),$E(HLECH),2))
165 . I DGPAT("POWLOC")'="@" S DGPAT("POWLOC")=$$POWLOC(DGPAT("POWLOC"),.ERROR) ;POW CONFINEMENT LOCATION
166 . I ERROR D Q
167 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 3, POW CONFINEMENT LOCATION",.ERRCOUNT)
168 . S DGPAT("POWFDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH)),"DATE",.ERROR) ;POW FROM DATE
169 . I ERROR D Q
170 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW FROM DATE",.ERRCOUNT)
171 . S DGPAT("POWTDT")=$$CONVERT^DGENUPL1($P(SEG(4),$E(HLECH),2),"DATE",.ERROR) ;POW TO DATE
172 . I ERROR D Q
173 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMH SEGMENT, SEQ 4, POW TO DATE",.ERRCOUNT)
174 Q
175 ;
176POWLOC(LOC,ERROR) ;POW Confinement Location mapping with HL7 table VA023
177 ; Input: LOC - HL7 code for location
178 ; Output: ERROR - Return error 1 on failure
179 ; IEN22 - IEN of file 22
180 N TBL023
181 S ERROR=0
182 ;Uncomment following line for EVC R2
183 ;I LOC="" S ERROR=1 Q ""
184 I LOC="" Q "" ;Remove this line for EVC R2
185 S TBL023(4)="WWI",TBL023(5)="WWII-EUROPE",TBL023(6)="WWII-PACIFIC"
186 S TBL023(7)="KOREAN",TBL023(8)="VIETNAM",TBL023(9)="OTHER"
187 S TBL023("A")="PERSIAN GULF",TBL023("B")="YUGOSLAVIA"
188 S IEN22=$O(^DIC(22,"C",TBL023(LOC),""))
189 I IEN22="" S ERROR=1
190 Q IEN22
191 ;
Note: See TracBrowser for help on using the repository browser.