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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 9/19/06 10:45am
2 ;;5.3;REGISTRATION;**397,379,497,451,564,672,659,583,653**;Aug 13,1993;Build 2
3 ;
4 ;***************************************************************
5 ; This routine was created because DGENUPL2 had reached it's
6 ; maximum size, therefore no new code could not be added. All
7 ; code that existed in the ZEL and OBX tags of DGENUPL2 has
8 ; been moved to the ZEL and OBX tags of DGENUPLA. A line of code
9 ; was placed in ZEL^DGENUPL2 to call ZEL^DGENUPLA. A line of
10 ; code was placed in OBX^DGENUPL2 to call OBX^DGENUPLA.
11 ; Any routine that calls ZEL^DGENUPL2 or OBX^DGENUPL2 will not
12 ; be affected by this change.
13 ;***************************************************************
14 ;
15 ;***************************************************************
16 ;The following procedures parse particular segment types.
17 ;Input:SEG(),MSGID
18 ;Output:DGPAT(),DGELG(),DGENR(),DGNTR(),DGMST(),ERROR
19 ;***************************************************************
20 ;
21 ;
22ZEL(COUNT) ;
23 N CODE
24 S CODE=$$CONVERT^DGENUPL1(SEG(2),"ELIGIBILITY",.ERROR)
25 I ERROR D Q
26 .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ELIGIBILITY CODE "_SEG(2)_" NOT FOUND IN ELIGIBILTIY CODE FILE",.ERRCOUNT)
27 I COUNT=1 D
28 .S DGELG("ELIG","CODE")=CODE
29 .;S DGELG("DISRET")=$$CONVERT^DGENUPL1(SEG(5))
30 .S DGELG("DISRET")=$$DISCONV(SEG(5)) ;DG*5.3*672
31 .I ERROR D Q
32 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 5",.ERRCOUNT)
33 .S DGELG("CLAIMNUM")=$$CONVERT^DGENUPL1(SEG(6))
34 .S DGELG("CLAIMLOC")=$$SITECNV(SEG(7))
35 .;
36 .S DGPAT("VETERAN")=$$CONVERT^DGENUPL1(SEG(8),"Y/N",.ERROR)
37 .I ERROR D Q
38 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 8",.ERRCOUNT)
39 .S DGELG("ELIGSTA")=$$CONVERT^DGENUPL1(SEG(10))
40 .S DGELG("ELIGSTADATE")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
41 .I ERROR D Q
42 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 11",.ERRCOUNT)
43 .S DGELG("ELIGVERIF")=$$CONVERT^DGENUPL1(SEG(13))
44 .S DGELG("A&A")=$$CONVERT^DGENUPL1(SEG(14),"Y/N",.ERROR)
45 .I ERROR D Q
46 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 14",.ERRCOUNT)
47 .S DGELG("HB")=$$CONVERT^DGENUPL1(SEG(15),"Y/N",.ERROR)
48 .I ERROR D Q
49 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 15",.ERRCOUNT)
50 .S DGELG("VAPEN")=$$CONVERT^DGENUPL1(SEG(16),"Y/N",.ERROR)
51 .I ERROR D Q
52 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 16",.ERRCOUNT)
53 .S DGELG("VADISAB")=$$CONVERT^DGENUPL1(SEG(17),"Y/N",.ERROR)
54 .I ERROR D Q
55 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 17",.ERRCOUNT)
56 .S DGELG("AO")=$$CONVERT^DGENUPL1(SEG(18),"Y/N",.ERROR)
57 .N AOERR S AOERR=ERROR ; See SEG(29) below.
58 .I ERROR D Q
59 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 18",.ERRCOUNT)
60 .S (DGPAT("IR"),DGELG("IR"))=$$CONVERT^DGENUPL1(SEG(19),"Y/N",.ERROR)
61 .I ERROR D Q
62 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 19",.ERRCOUNT)
63 .S DGELG("EC")=$$CONVERT^DGENUPL1(SEG(20),"Y/N",.ERROR)
64 .I ERROR D Q
65 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 20",.ERRCOUNT)
66 .S (DGPAT("RADEXPM"),DGELG("RADEXPM"))=$G(SEG(22))
67 .S ERROR=$S(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,"[(","_DGELG("RADEXPM")_","):0,1:1)
68 .I ERROR D Q
69 ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
70 .;
71 .S DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
72 .;
73 .;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
74 . S DGMST("MSTSTAT")=SEG(23)
75 . S DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
76 . I ERROR D Q
77 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
78 . S DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
79 . I ERROR D Q
80 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
81 .;
82 . S DGELG("AOEXPLOC")=SEG(29)
83 .; Logic enhanced during SQA of patch 451. AOERR from SEG(18) above.
84 . I 'AOERR,DGELG("AO")'="Y",DGELG("AOEXPLOC")="" S DGELG("AOEXPLOC")="@"
85 . S DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
86 . I ERROR D Q
87 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
88 . S DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
89 . I ERROR D Q
90 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
91 . S DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
92 . I ERROR D Q
93 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
94 . I $G(DGELG("DISLOD"))="" S DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR) ;Discharge due to Disability - DG*5.3*672
95 . I ERROR D Q
96 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
97 . S DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR) ;Proj 112/SHAD - DG*5.3*653
98 . I ERROR D Q
99 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
100 ;
101 I COUNT>1 D
102 .S DGELG("ELIG","CODE",CODE)=""
103 Q
104 ;
105OBX N OBXPCE,OBXVAL,OBXTBL,I,CS,SS,RS
106 I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
107 I $G(HLFS)="" N HLFS S HLFS="^"
108 S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
109 I $G(SEG(3))=("38.1"_$E(HLECH)_"SECURITY LOG") D
110 . N LEVEL
111 . S LEVEL=$P(SEG(5),$E(HLECH))
112 . S DGSEC("LEVEL")=$$CONVERT^DGENUPL1(LEVEL,"1/0",.ERROR)
113 . I ERROR D Q
114 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 5",.ERRCOUNT)
115 . S DGSEC("DATETIME")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
116 . I ERROR D Q
117 . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 14, Patient Sensitivity Date/Time",.ERRCOUNT) ;DG*5.3*653
118 . S DGSEC("SOURCE")=$$CONVERT^DGENUPL1(SEG(16))
119 ;
120 I $G(SEG(3))=("VISTA"_CS_"28.11") D
121 . S OBXTBL(1)="NTR^Y",OBXTBL(2)="AVI^Y",OBXTBL(3)="SUB^Y"
122 . S OBXTBL(4)="HNC^Y",OBXTBL(5)="NTR^N",OBXTBL(6)="AVI^N"
123 . S OBXTBL(7)="SUB^N",OBXTBL(8)="HNC^N",OBXTBL(9)="NTR^U"
124 . F I=1:1:$L($G(SEG(5)),RS) D
125 . . S OBXPCE=$P($G(SEG(5)),RS,I),OBXVAL=$P($G(OBXPCE),CS)
126 . . S DGNTR($P($G(OBXTBL(OBXVAL)),"^"))=$P($G(OBXTBL(OBXVAL)),"^",2)
127 . I $G(SEG(12))'="" S DGNTR("HDT")=$$CONVERT^DGENUPL1(SEG(12),"TS",.ERROR)
128 . S DGNTR("VDT")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
129 . S DGNTR("VSIT")=$$CONVERT^DGENUPL1(SEG(15),"INSTITUTION",.ERROR)
130 . S DGNTR("HSIT")=$P($P($G(SEG(16)),CS,14),SS,2)
131 . I DGNTR("HSIT")'="" S DGNTR("HSIT")=$$CONVERT^DGENUPL1($G(DGNTR("HSIT")),"INSTITUTION",.ERROR)
132 . S DGNTR("VER")=$P($G(SEG(17)),CS)
133 Q
134 ;
135ZIO ;New segment - DG*5.3*653
136 S DGPAT("APPREQ")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
137 I ERROR D Q
138 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 5, APPOINTMENT REQUEST ON 1010EZ",.ERRCOUNT)
139 S DGPAT("APPREQDT")=$$CONVERT^DGENUPL1(SEG(6),"DATE",.ERROR)
140 I ERROR D Q
141 . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST DATE",.ERRCOUNT)
142 Q
143 ;
144DISCONV(VAL,ERROR) ;
145 ;DG*5.3*672 - Military Disability conversion to new values
146 N DISRET
147 S ERROR=0
148 I VAL="" Q VAL
149 I VAL="""""" S VAL="@" Q VAL
150 I ((VAL="Y")!(VAL="N")) D Q DISRET
151 . S DISRET=$$CONVERT^DGENUPL1(VAL,"1/0",.ERROR)
152 S (DISRET,DGELG("DISLOD"))=$S(VAL=0:0,VAL=1:1,VAL=2:1,VAL=3:0,1:"")
153 I DISRET="" S ERROR=1 Q VAL
154 Q DISRET
155 ;
156SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
157 ; ptr to file 4
158 N SITE
159 S SITE=""
160 I STRING'="" D
161 . N SUB,START,END
162 . ; Find site ien if only site # is returned
163 . I $O(^DIC(4,"D",STRING,0)) S SITE=$O(^DIC(4,"D",STRING,0)) Q
164 . ; Check if name is concatenated onto site # to find site ien
165 . S SUB=""
166 . F S SUB=$O(^DIC(4,"D",SUB)) Q:SUB="" I $E(SUB,1,3)=$E(STRING,1,3),$$CHK(SUB,STRING) S SITE=$O(^DIC(4,"D",SUB,0)) Q
167 ; SITE is the pointer to file 4 or null for site not found
168 Q SITE
169 ;
170CHK(SUB,STRING) ;
171 N IEN,X,STN,RET
172 I SUB=STRING Q 1
173 S RET=0
174 S IEN=+$O(^DIC(4,"D",SUB,""))
175 I IEN D
176 . S X=$P($G(^DIC(4,IEN,0)),U),STN=$P($G(^(99)),U)
177 . ; assume institution file names will be the same on HEC and VistA
178 . I STN=SUB,X'="",$E($P(STRING,SUB,2,999),1,40)=X S RET=1
179 Q RET
180 ;
Note: See TracBrowser for help on using the repository browser.