DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM,JAM,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;7/18/24 12:40PM
;;5.3;REGISTRATION;**397,379,497,451,564,672,659,583,653,688,754,909,978,952,1064,1090,1103,1121**;Aug 13,1993;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
;***************************************************************
; This routine was created because DGENUPL2 had reached it's
; maximum size, therefore no new code could not be added. All
; code that existed in the ZEL and OBX tags of DGENUPL2 has
; been moved to the ZEL,ZPD and OBX tags of DGENUPLA. A line of code
; was placed in ZEL^DGENUPL2 to call ZEL^DGENUPLA. A line of
; code was placed in OBX^DGENUPL2 to call OBX^DGENUPLA.
; Any routine that calls ZEL,ZPD or OBX^DGENUPL2 will not
; be affected by this change.
;***************************************************************
;
;***************************************************************
;The following procedures parse particular segment types.
;Input:SEG(),MSGID
;Output:DGPAT(),DGELG(),DGENR(),DGNTR(),DGMST(),ERROR
;***************************************************************
;
;
ZEL(COUNT) ;
N CODE,SEQ
S CODE=$$CONVERT^DGENUPL1(SEG(2),"ELIGIBILITY",.ERROR)
I ERROR D Q
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ELIGIBILITY CODE "_SEG(2)_" NOT FOUND IN ELIGIBILTIY CODE FILE",.ERRCOUNT)
I COUNT=1 D
.S DGELG("ELIG","CODE")=CODE
.S DGELG("DISRET")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 5",.ERRCOUNT)
.S DGELG("CLAIMNUM")=$$CONVERT^DGENUPL1(SEG(6))
.S DGELG("CLAIMLOC")=$$SITECNV(SEG(7))
.;
.S DGPAT("VETERAN")=$$CONVERT^DGENUPL1(SEG(8),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 8",.ERRCOUNT)
.S DGELG("ELIGSTA")=$$CONVERT^DGENUPL1(SEG(10))
.S DGELG("ELIGSTADATE")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 11",.ERRCOUNT)
.S DGELG("ELIGVERIF")=$$CONVERT^DGENUPL1(SEG(13))
.S DGELG("A&A")=$$CONVERT^DGENUPL1(SEG(14),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 14",.ERRCOUNT)
.S DGELG("HB")=$$CONVERT^DGENUPL1(SEG(15),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 15",.ERRCOUNT)
.S DGELG("VAPEN")=$$CONVERT^DGENUPL1(SEG(16),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 16",.ERRCOUNT)
.S DGELG("VADISAB")=$$CONVERT^DGENUPL1(SEG(17),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 17",.ERRCOUNT)
.S DGELG("AO")=$$CONVERT^DGENUPL1(SEG(18),"Y/N",.ERROR)
.N AOERR S AOERR=ERROR ; See SEG(29) below.
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 18",.ERRCOUNT)
.S (DGPAT("IR"),DGELG("IR"))=$$CONVERT^DGENUPL1(SEG(19),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 19",.ERRCOUNT)
.S DGELG("EC")=$$CONVERT^DGENUPL1(SEG(20),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 20",.ERRCOUNT)
.S (DGPAT("RADEXPM"),DGELG("RADEXPM"))=$$CONVERT^DGENUPL1($G(SEG(22)))
.;DG*5.3*1090 - Add 8,9,10
.S ERROR=$S(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,8,9,10,"[(","_DGELG("RADEXPM")_","):0,DGELG("RADEXPM")="@":0,1:1)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
.;
.S DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
.;
.;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
.F SEQ=23,24,25 S:SEG(SEQ)=HLQ SEG(SEQ)=""
.S DGMST("MSTSTAT")=$$CONVERT^DGENUPL1(SEG(23))
.S DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
.S DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
.;
.S DGELG("AOEXPLOC")=$$CONVERT^DGENUPL1(SEG(29))
.; Logic enhanced during SQA of patch 451. AOERR from SEG(18) above.
.I 'AOERR,DGELG("AO")'="Y",DGELG("AOEXPLOC")="" S DGELG("AOEXPLOC")="@"
.S DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
.S DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
.S DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
.;DG*5.3*1090 - Populate the source in ^TMP global
.S ^TMP("DGCVE",$J,"COMBAT VET ELIG END DATE SOURCE",DFN)="ES"
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
.I $G(DGELG("DISLOD"))="" S DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR) ;Discharge due to Disability - DG*5.3*653
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
.S DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR) ;Proj 112/SHAD - DG*5.3*653
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
.; Camp Lejeune data checking added - DG*5.3*909
.S DGELG("CLE")=$$CONVERT^DGENUPL1(SEG(41),"Y/N",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 41",.ERRCOUNT)
.S DGELG("CLEDT")=$$CONVERT^DGENUPL1(SEG(42),"DATE",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 42",.ERRCOUNT)
.S DGELG("CLEST")=$$CONVERT^DGENUPL1(SEG(43))
.S DGELG("CLESOR")=$$CONVERT^DGENUPL1(SEG(44))
.; DG*5.3*1103 - Parse Toxic Exposure Risk Activity (TERA) field into DGPAT array
.S ERROR=0
.S DGPAT("TERA")=$$CONVERT^DGENUPL1($G(SEG(48)))
.I ((DGPAT("TERA")'=0)&(DGPAT("TERA")'=1)) S ERROR=1
.I ((DGPAT("TERA")="")!(DGPAT("TERA")="@")) S ERROR=0
.I (DGPAT("TERA"))="" K DGPAT("TERA")
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 48",.ERRCOUNT)
.;DG*5.3*1121 - Parse Persian Gulf Indicator field and Last change date field into DGPAT("PGULF") and DGPAT("PGULFTS") array
.S ERROR=0
.S DGPAT("PGULF")=$$CONVERT^DGENUPL1($G(SEG(49)))
.I ((DGPAT("PGULF")'=0)&(DGPAT("PGULF")'=1)) S ERROR=1
.I ((DGPAT("PGULF")="")!(DGPAT("PGULF")="@")) S ERROR=0
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 49",.ERRCOUNT)
.S ERROR=0
.S DGPAT("PGULFTS")=$$CONVERT^DGENUPL1(SEG(50),"TS",.ERROR)
.I ERROR D Q
..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 50",.ERRCOUNT)
.; OTH data DG*5.3*952
.I COUNT=1 D
..S DGELG("OTH")=$$CONVERT^DGENUPL1($G(SEG(45)))
..S DGELG("OTHTYPE")=$$CONVERT^DGENUPL1($G(SEG(46)))
..I DGELG("OTH")=1,"^1^2^"'[(U_DGELG("OTHTYPE")_U) S ERROR=1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 46",.ERRCOUNT) Q
..S DGELG("OTHTS")=$$CONVERT^DGENUPL1(SEG(47),"TS",.ERROR) I ERROR D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 47",.ERRCOUNT) Q
..S DGELG("OTHTYPE")=$S(DGELG("OTHTYPE")=1:"OTH-90",DGELG("OTHTYPE")=2:"OTH-EXT",1:"")
..; make sure that timestamp in ZEL.47 is not older than last timestamp in sub-file 33.02
..I $$GET1^DIQ(8,CODE_",",.01)="EXPANDED MH CARE NON-ENROLLEE",$$GET1^DIQ(2,DFN_",",.361)="EXPANDED MH CARE NON-ENROLLEE" D
...; primary eligibility is "EXPANDED MH CARE NON-ENROLLEE" in both Z11 and VistA
...I DGELG("OTHTYPE")="OTH-90",$$GET1^DIQ(2,DFN_",",.5501,"I")="OTH-EXT" D
....; OTH care type is OTH-90 in Z11, but is OTH-EXT in VistA
....I $$FMDIFF^XLFDT(DGELG("OTHTS"),$$GETTIMST^DGOTHEL(DFN),2)<0 D
.....; local timestamp in 33.02 is more recent than one in ZEL.47
.....S ERROR=1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"MH CARE TYPE IS OTH-EXT AND IS MORE RECENT IN VISTA",.ERRCOUNT)
.....Q
....Q
...Q
..Q
.Q
;
I COUNT>1 D
.S DGELG("ELIG","CODE",CODE)=""
Q
;
OBX ;
N OBXPCE,OBXVAL,OBXTBL,I,CS,SS,RS
I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
I $G(HLFS)="" N HLFS S HLFS="^"
S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
I $G(SEG(3))=("38.1"_$E(HLECH)_"SECURITY LOG") D
. N LEVEL
. S LEVEL=$P(SEG(5),$E(HLECH))
. S DGSEC("LEVEL")=$$CONVERT^DGENUPL1(LEVEL,"1/0",.ERROR)
. I ERROR D Q
. . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 5",.ERRCOUNT)
. S DGSEC("DATETIME")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
. I ERROR D Q
. . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 14, Patient Sensitivity Date/Time",.ERRCOUNT) ;DG*5.3*653
. S DGSEC("SOURCE")=$$CONVERT^DGENUPL1(SEG(16))
;
I $G(SEG(3))=("VISTA"_CS_"28.11") D
. S OBXTBL(1)="NTR^Y",OBXTBL(2)="AVI^Y",OBXTBL(3)="SUB^Y"
. S OBXTBL(4)="HNC^Y",OBXTBL(5)="NTR^N",OBXTBL(6)="AVI^N"
. S OBXTBL(7)="SUB^N",OBXTBL(8)="HNC^N",OBXTBL(9)="NTR^U"
. F I=1:1:$L($G(SEG(5)),RS) D
. . S OBXPCE=$P($G(SEG(5)),RS,I),OBXVAL=$P($G(OBXPCE),CS)
. . S DGNTR($P($G(OBXTBL(OBXVAL)),"^"))=$P($G(OBXTBL(OBXVAL)),"^",2)
. I $G(SEG(12))'="" S DGNTR("HDT")=$$CONVERT^DGENUPL1(SEG(12),"TS",.ERROR)
. S DGNTR("VDT")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
. S DGNTR("VSIT")=$$CONVERT^DGENUPL1(SEG(15),"INSTITUTION",.ERROR)
. S DGNTR("HSIT")=$P($P($G(SEG(16)),CS,14),SS,2)
. I DGNTR("HSIT")'="" S DGNTR("HSIT")=$$CONVERT^DGENUPL1($G(DGNTR("HSIT")),"INSTITUTION",.ERROR)
. S DGNTR("VER")=$$CONVERT^DGENUPL1($P($G(SEG(17)),CS))
Q
;
ZIO ;New segment - DG*5.3*653
S DGPAT("APPREQ")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 5, APPOINTMENT REQUEST ON 1010EZ",.ERRCOUNT)
S DGPAT("APPREQDT")=$$CONVERT^DGENUPL1(SEG(6),"DATE",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST DATE",.ERRCOUNT)
; jam; DG*5.3*978 - segments 7-10 added
S DGPAT("APPREQTS")=$$CONVERT^DGENUPL1(SEG(7),"TS",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST ON 1010EZ CHG DATE/TIME",.ERRCOUNT)
S DGPAT("ORIGAPPREQ")=$$CONVERT^DGENUPL1(SEG(8),"1/0",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 8, ORIGINAL APPOINTMENT REQUEST",.ERRCOUNT)
S DGPAT("ORIGAPPREQDT")=$$CONVERT^DGENUPL1(SEG(9),"DATE",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 9, ORIGINAL APPOINTMENT REQUEST DATE",.ERRCOUNT)
S DGPAT("ORIGAPPREQTS")=$$CONVERT^DGENUPL1(SEG(10),"TS",.ERROR)
I ERROR D Q
. D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 10, ORIGINAL APPOINTMENT REQUEST CHG DT/TIME",.ERRCOUNT)
; jam; DG*5.3*978 - begin various validations that are done to determine whether certain fields should be filed or dropped or an error sent back
; If not deleting ORIGINAL APPT REQUEST, Do not store Original Appt Request fields (1010.1512, 1010.1513, 1010.1514) if current value of field 1010.1512 in Vista is not blank
I DGPAT("ORIGAPPREQ")'="@" D
. I $$GET1^DIQ(2,DFN,1010.1512,"I")'="" K DGPAT("ORIGAPPREQ"),DGPAT("ORIGAPPREQDT"),DGPAT("ORIGAPPREQTS")
;
;These are the rules for the other 1010 fields (1010.159, 1010.1511 and 1010.1515):
;
;Value of Value of 1010.159 Compare 1010.1515
;1010EZ field 1010EZ field with Z11 "APPREQTS"
;Incoming Z11 in Vista DB Which is more recent? Resulting Process
;------------------------------------------------------------------------------------------------------------------------
;1. YES/NO YES/NO Vista Ignore the ZIO 1010 fields - no error is sent, process the Z11
;2. NO YES Z11 Reject the Z11 - send error back
;3. All other cases --- --- File the fields
;
; Case 1: If the incoming Z11 appt request date/time change is not "@" and is older that the Vista date/time change,
; don't file the fields - we don't throw an error for these cases.
I DGPAT("APPREQTS")'="@",DGPAT("APPREQTS")<$$GET1^DIQ(2,DFN,1010.1515,"I") K DGPAT("APPREQTS"),DGPAT("APPREQ"),DGPAT("APPREQDT") Q
; Case 2 - If not deleting Appt. Request, changing a YES in Vista to a NO is not allowed and an error is generated
I DGPAT("APPREQ")'="@",(DGPAT("APPREQ")=0)&($$GET1^DIQ(2,DFN,1010.159,"I")=1) D Q
.S ERROR=1
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST ON 1010EZ - VISTA VALUE IS YES",.ERRCOUNT)
;
; last check - field 1010.1511 APPOINTMENT REQUEST DATE must not be a future date
I DGPAT("APPREQDT")>DT D Q
.S ERROR=1
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST DATE - FUTURE DATE",.ERRCOUNT)
; jam; DG*5.3*978 - end of validations - data can be filed.
Q
;
ZPD ;
S DGELG("RATEINC")=$$CONVERT^DGENUPL1(SEG(8))
S DGPAT("DEATH")=$$CONVERT^DGENUPL1(SEG(9),"TS",.ERROR)
I ERROR D Q
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 9",.ERRCOUNT)
S DGELG("MEDICAID")=$$CONVERT^DGENUPL1(SEG(12))
S DGELG("MEDASKDT")=$$CONVERT^DGENUPL1(SEG(13),"TS",.ERROR)
I ERROR D Q
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 13",.ERRCOUNT)
S DGELG("POW")=$$CONVERT^DGENUPL1(SEG(17))
S DGPAT("SPININJ")=$$CONVERT^DGENUPL1(SEG(30))
S ERROR=$S(DGPAT("SPININJ")="":0,",1,2,3,4,X,"[(","_DGPAT("SPININJ")_","):0,DGPAT("SPININJ")="@":0,1:1)
I ERROR D Q
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 30",.ERRCOUNT)
;DG*5.3*688
S DGPAT("AG/ALLY")=$$CONVERT^DGENUPL1(SEG(35),"AGENCY",.ERROR)
I ERROR D
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 35",.ERRCOUNT)
S DGPAT("EMGRES")=$$CONVERT^DGENUPL1(SEG(40)) ;DG*5.3*677
; KUM - DG*5.3*1064
S DGPAT("INDID")=$$CONVERT^DGENUPL1(SEG(42),"Y/N",.ERROR)
I ERROR D
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDID")),"BAD VALUE, ZPD SEGMENT, SEQ 42",.ERRCOUNT)
S DGPAT("INDADT")=$$CONVERT^DGENUPL1(SEG(43),"DATE",.ERROR)
I ERROR D
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDADT")),"BAD VALUE, ZPD SEGMENT, SEQ 43",.ERRCOUNT)
S DGPAT("INDSDT")=$$CONVERT^DGENUPL1(SEG(44),"DATE",.ERROR)
I ERROR D
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDSDT")),"BAD VALUE, ZPD SEGMENT, SEQ 44",.ERRCOUNT)
S DGPAT("INDEDT")=$$CONVERT^DGENUPL1(SEG(45),"DATE",.ERROR)
I ERROR D
.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDEDT")),"BAD VALUE, ZPD SEGMENT, SEQ 45",.ERRCOUNT)
Q
;
SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
; pointer to file 4
N SITE
S SITE=""
I STRING'="" D
. N SUB,START,END
. ; Find site ien if only site # is returned
. I $O(^DIC(4,"D",STRING,0)) S SITE=$O(^DIC(4,"D",STRING,0)) Q
. ; Check if name is concatenated onto site # to find site ien
. S SUB=""
. 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
; SITE is the pointer to file 4 or null for site not found
Q SITE
;
CHK(SUB,STRING) ;
N IEN,X,STN,RET
I SUB=STRING Q 1
S RET=0
S IEN=+$O(^DIC(4,"D",SUB,""))
I IEN D
. S X=$P($G(^DIC(4,IEN,0)),U),STN=$P($G(^(99)),U)
. ; assume institution file names will be the same on HEC and VistA
. I STN=SUB,X'="",$E($P(STRING,SUB,2,999),1,40)=X S RET=1
Q RET
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENUPLA 15940 printed Sep 23, 2025@20:19:17 Page 2
DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM,JAM,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;7/18/24 12:40PM
+1 ;;5.3;REGISTRATION;**397,379,497,451,564,672,659,583,653,688,754,909,978,952,1064,1090,1103,1121**;Aug 13,1993;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+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,ZPD 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,ZPD 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 ;
ZEL(COUNT) ;
+1 NEW CODE,SEQ
+2 SET CODE=$$CONVERT^DGENUPL1(SEG(2),"ELIGIBILITY",.ERROR)
+3 IF ERROR
Begin DoDot:1
+4 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"ELIGIBILITY CODE "_SEG(2)_" NOT FOUND IN ELIGIBILTIY CODE FILE",.ERRCOUNT)
End DoDot:1
QUIT
+5 IF COUNT=1
Begin DoDot:1
+6 SET DGELG("ELIG","CODE")=CODE
+7 SET DGELG("DISRET")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
+8 IF ERROR
Begin DoDot:2
+9 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 5",.ERRCOUNT)
End DoDot:2
QUIT
+10 SET DGELG("CLAIMNUM")=$$CONVERT^DGENUPL1(SEG(6))
+11 SET DGELG("CLAIMLOC")=$$SITECNV(SEG(7))
+12 ;
+13 SET DGPAT("VETERAN")=$$CONVERT^DGENUPL1(SEG(8),"Y/N",.ERROR)
+14 IF ERROR
Begin DoDot:2
+15 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 8",.ERRCOUNT)
End DoDot:2
QUIT
+16 SET DGELG("ELIGSTA")=$$CONVERT^DGENUPL1(SEG(10))
+17 SET DGELG("ELIGSTADATE")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
+18 IF ERROR
Begin DoDot:2
+19 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 11",.ERRCOUNT)
End DoDot:2
QUIT
+20 SET DGELG("ELIGVERIF")=$$CONVERT^DGENUPL1(SEG(13))
+21 SET DGELG("A&A")=$$CONVERT^DGENUPL1(SEG(14),"Y/N",.ERROR)
+22 IF ERROR
Begin DoDot:2
+23 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 14",.ERRCOUNT)
End DoDot:2
QUIT
+24 SET DGELG("HB")=$$CONVERT^DGENUPL1(SEG(15),"Y/N",.ERROR)
+25 IF ERROR
Begin DoDot:2
+26 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 15",.ERRCOUNT)
End DoDot:2
QUIT
+27 SET DGELG("VAPEN")=$$CONVERT^DGENUPL1(SEG(16),"Y/N",.ERROR)
+28 IF ERROR
Begin DoDot:2
+29 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 16",.ERRCOUNT)
End DoDot:2
QUIT
+30 SET DGELG("VADISAB")=$$CONVERT^DGENUPL1(SEG(17),"Y/N",.ERROR)
+31 IF ERROR
Begin DoDot:2
+32 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 17",.ERRCOUNT)
End DoDot:2
QUIT
+33 SET DGELG("AO")=$$CONVERT^DGENUPL1(SEG(18),"Y/N",.ERROR)
+34 ; See SEG(29) below.
NEW AOERR
SET AOERR=ERROR
+35 IF ERROR
Begin DoDot:2
+36 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 18",.ERRCOUNT)
End DoDot:2
QUIT
+37 SET (DGPAT("IR"),DGELG("IR"))=$$CONVERT^DGENUPL1(SEG(19),"Y/N",.ERROR)
+38 IF ERROR
Begin DoDot:2
+39 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 19",.ERRCOUNT)
End DoDot:2
QUIT
+40 SET DGELG("EC")=$$CONVERT^DGENUPL1(SEG(20),"Y/N",.ERROR)
+41 IF ERROR
Begin DoDot:2
+42 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 20",.ERRCOUNT)
End DoDot:2
QUIT
+43 SET (DGPAT("RADEXPM"),DGELG("RADEXPM"))=$$CONVERT^DGENUPL1($GET(SEG(22)))
+44 ;DG*5.3*1090 - Add 8,9,10
+45 SET ERROR=$SELECT(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,8,9,10,"[(","_DGELG("RADEXPM")_","):0,DGELG("RADEXPM")="@":0,1:1)
+46 IF ERROR
Begin DoDot:2
+47 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
End DoDot:2
QUIT
+48 ;
+49 SET DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
+50 ;
+51 ;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
+52 FOR SEQ=23,24,25
if SEG(SEQ)=HLQ
SET SEG(SEQ)=""
+53 SET DGMST("MSTSTAT")=$$CONVERT^DGENUPL1(SEG(23))
+54 SET DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
+55 IF ERROR
Begin DoDot:2
+56 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
End DoDot:2
QUIT
+57 SET DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
+58 IF ERROR
Begin DoDot:2
+59 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
End DoDot:2
QUIT
+60 ;
+61 SET DGELG("AOEXPLOC")=$$CONVERT^DGENUPL1(SEG(29))
+62 ; Logic enhanced during SQA of patch 451. AOERR from SEG(18) above.
+63 IF 'AOERR
IF DGELG("AO")'="Y"
IF DGELG("AOEXPLOC")=""
SET DGELG("AOEXPLOC")="@"
+64 SET DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
+65 IF ERROR
Begin DoDot:2
+66 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
End DoDot:2
QUIT
+67 SET DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
+68 IF ERROR
Begin DoDot:2
+69 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
End DoDot:2
QUIT
+70 SET DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
+71 ;DG*5.3*1090 - Populate the source in ^TMP global
+72 SET ^TMP("DGCVE",$JOB,"COMBAT VET ELIG END DATE SOURCE",DFN)="ES"
+73 IF ERROR
Begin DoDot:2
+74 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
End DoDot:2
QUIT
+75 ;Discharge due to Disability - DG*5.3*653
IF $GET(DGELG("DISLOD"))=""
SET DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR)
+76 IF ERROR
Begin DoDot:2
+77 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
End DoDot:2
QUIT
+78 ;Proj 112/SHAD - DG*5.3*653
SET DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR)
+79 IF ERROR
Begin DoDot:2
+80 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
End DoDot:2
QUIT
+81 ; Camp Lejeune data checking added - DG*5.3*909
+82 SET DGELG("CLE")=$$CONVERT^DGENUPL1(SEG(41),"Y/N",.ERROR)
+83 IF ERROR
Begin DoDot:2
+84 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 41",.ERRCOUNT)
End DoDot:2
QUIT
+85 SET DGELG("CLEDT")=$$CONVERT^DGENUPL1(SEG(42),"DATE",.ERROR)
+86 IF ERROR
Begin DoDot:2
+87 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 42",.ERRCOUNT)
End DoDot:2
QUIT
+88 SET DGELG("CLEST")=$$CONVERT^DGENUPL1(SEG(43))
+89 SET DGELG("CLESOR")=$$CONVERT^DGENUPL1(SEG(44))
+90 ; DG*5.3*1103 - Parse Toxic Exposure Risk Activity (TERA) field into DGPAT array
+91 SET ERROR=0
+92 SET DGPAT("TERA")=$$CONVERT^DGENUPL1($GET(SEG(48)))
+93 IF ((DGPAT("TERA")'=0)&(DGPAT("TERA")'=1))
SET ERROR=1
+94 IF ((DGPAT("TERA")="")!(DGPAT("TERA")="@"))
SET ERROR=0
+95 IF (DGPAT("TERA"))=""
KILL DGPAT("TERA")
+96 IF ERROR
Begin DoDot:2
+97 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 48",.ERRCOUNT)
End DoDot:2
QUIT
+98 ;DG*5.3*1121 - Parse Persian Gulf Indicator field and Last change date field into DGPAT("PGULF") and DGPAT("PGULFTS") array
+99 SET ERROR=0
+100 SET DGPAT("PGULF")=$$CONVERT^DGENUPL1($GET(SEG(49)))
+101 IF ((DGPAT("PGULF")'=0)&(DGPAT("PGULF")'=1))
SET ERROR=1
+102 IF ((DGPAT("PGULF")="")!(DGPAT("PGULF")="@"))
SET ERROR=0
+103 IF ERROR
Begin DoDot:2
+104 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 49",.ERRCOUNT)
End DoDot:2
QUIT
+105 SET ERROR=0
+106 SET DGPAT("PGULFTS")=$$CONVERT^DGENUPL1(SEG(50),"TS",.ERROR)
+107 IF ERROR
Begin DoDot:2
+108 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 50",.ERRCOUNT)
End DoDot:2
QUIT
+109 ; OTH data DG*5.3*952
+110 IF COUNT=1
Begin DoDot:2
+111 SET DGELG("OTH")=$$CONVERT^DGENUPL1($GET(SEG(45)))
+112 SET DGELG("OTHTYPE")=$$CONVERT^DGENUPL1($GET(SEG(46)))
+113 IF DGELG("OTH")=1
IF "^1^2^"'[(U_DGELG("OTHTYPE")_U)
SET ERROR=1
DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 46",.ERRCOUNT)
QUIT
+114 SET DGELG("OTHTS")=$$CONVERT^DGENUPL1(SEG(47),"TS",.ERROR)
IF ERROR
DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 47",.ERRCOUNT)
QUIT
+115 SET DGELG("OTHTYPE")=$SELECT(DGELG("OTHTYPE")=1:"OTH-90",DGELG("OTHTYPE")=2:"OTH-EXT",1:"")
+116 ; make sure that timestamp in ZEL.47 is not older than last timestamp in sub-file 33.02
+117 IF $$GET1^DIQ(8,CODE_",",.01)="EXPANDED MH CARE NON-ENROLLEE"
IF $$GET1^DIQ(2,DFN_",",.361)="EXPANDED MH CARE NON-ENROLLEE"
Begin DoDot:3
+118 ; primary eligibility is "EXPANDED MH CARE NON-ENROLLEE" in both Z11 and VistA
+119 IF DGELG("OTHTYPE")="OTH-90"
IF $$GET1^DIQ(2,DFN_",",.5501,"I")="OTH-EXT"
Begin DoDot:4
+120 ; OTH care type is OTH-90 in Z11, but is OTH-EXT in VistA
+121 IF $$FMDIFF^XLFDT(DGELG("OTHTS"),$$GETTIMST^DGOTHEL(DFN),2)<0
Begin DoDot:5
+122 ; local timestamp in 33.02 is more recent than one in ZEL.47
+123 SET ERROR=1
DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"MH CARE TYPE IS OTH-EXT AND IS MORE RECENT IN VISTA",.ERRCOUNT)
+124 QUIT
End DoDot:5
+125 QUIT
End DoDot:4
+126 QUIT
End DoDot:3
+127 QUIT
End DoDot:2
+128 QUIT
End DoDot:1
+129 ;
+130 IF COUNT>1
Begin DoDot:1
+131 SET DGELG("ELIG","CODE",CODE)=""
End DoDot:1
+132 QUIT
+133 ;
OBX ;
+1 NEW OBXPCE,OBXVAL,OBXTBL,I,CS,SS,RS
+2 IF $GET(HLECH)'="~|\&"
NEW HLECH
SET HLECH="~|\&"
+3 IF $GET(HLFS)=""
NEW HLFS
SET HLFS="^"
+4 SET CS=$EXTRACT(HLECH,1)
SET SS=$EXTRACT(HLECH,4)
SET RS=$EXTRACT(HLECH,2)
+5 IF $GET(SEG(3))=("38.1"_$EXTRACT(HLECH)_"SECURITY LOG")
Begin DoDot:1
+6 NEW LEVEL
+7 SET LEVEL=$PIECE(SEG(5),$EXTRACT(HLECH))
+8 SET DGSEC("LEVEL")=$$CONVERT^DGENUPL1(LEVEL,"1/0",.ERROR)
+9 IF ERROR
Begin DoDot:2
+10 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 5",.ERRCOUNT)
End DoDot:2
QUIT
+11 SET DGSEC("DATETIME")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
+12 IF ERROR
Begin DoDot:2
+13 ;DG*5.3*653
DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 14, Patient Sensitivity Date/Time",.ERRCOUNT)
End DoDot:2
QUIT
+14 SET DGSEC("SOURCE")=$$CONVERT^DGENUPL1(SEG(16))
End DoDot:1
+15 ;
+16 IF $GET(SEG(3))=("VISTA"_CS_"28.11")
Begin DoDot:1
+17 SET OBXTBL(1)="NTR^Y"
SET OBXTBL(2)="AVI^Y"
SET OBXTBL(3)="SUB^Y"
+18 SET OBXTBL(4)="HNC^Y"
SET OBXTBL(5)="NTR^N"
SET OBXTBL(6)="AVI^N"
+19 SET OBXTBL(7)="SUB^N"
SET OBXTBL(8)="HNC^N"
SET OBXTBL(9)="NTR^U"
+20 FOR I=1:1:$LENGTH($GET(SEG(5)),RS)
Begin DoDot:2
+21 SET OBXPCE=$PIECE($GET(SEG(5)),RS,I)
SET OBXVAL=$PIECE($GET(OBXPCE),CS)
+22 SET DGNTR($PIECE($GET(OBXTBL(OBXVAL)),"^"))=$PIECE($GET(OBXTBL(OBXVAL)),"^",2)
End DoDot:2
+23 IF $GET(SEG(12))'=""
SET DGNTR("HDT")=$$CONVERT^DGENUPL1(SEG(12),"TS",.ERROR)
+24 SET DGNTR("VDT")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
+25 SET DGNTR("VSIT")=$$CONVERT^DGENUPL1(SEG(15),"INSTITUTION",.ERROR)
+26 SET DGNTR("HSIT")=$PIECE($PIECE($GET(SEG(16)),CS,14),SS,2)
+27 IF DGNTR("HSIT")'=""
SET DGNTR("HSIT")=$$CONVERT^DGENUPL1($GET(DGNTR("HSIT")),"INSTITUTION",.ERROR)
+28 SET DGNTR("VER")=$$CONVERT^DGENUPL1($PIECE($GET(SEG(17)),CS))
End DoDot:1
+29 QUIT
+30 ;
ZIO ;New segment - DG*5.3*653
+1 SET DGPAT("APPREQ")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
+2 IF ERROR
Begin DoDot:1
+3 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 5, APPOINTMENT REQUEST ON 1010EZ",.ERRCOUNT)
End DoDot:1
QUIT
+4 SET DGPAT("APPREQDT")=$$CONVERT^DGENUPL1(SEG(6),"DATE",.ERROR)
+5 IF ERROR
Begin DoDot:1
+6 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST DATE",.ERRCOUNT)
End DoDot:1
QUIT
+7 ; jam; DG*5.3*978 - segments 7-10 added
+8 SET DGPAT("APPREQTS")=$$CONVERT^DGENUPL1(SEG(7),"TS",.ERROR)
+9 IF ERROR
Begin DoDot:1
+10 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST ON 1010EZ CHG DATE/TIME",.ERRCOUNT)
End DoDot:1
QUIT
+11 SET DGPAT("ORIGAPPREQ")=$$CONVERT^DGENUPL1(SEG(8),"1/0",.ERROR)
+12 IF ERROR
Begin DoDot:1
+13 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 8, ORIGINAL APPOINTMENT REQUEST",.ERRCOUNT)
End DoDot:1
QUIT
+14 SET DGPAT("ORIGAPPREQDT")=$$CONVERT^DGENUPL1(SEG(9),"DATE",.ERROR)
+15 IF ERROR
Begin DoDot:1
+16 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 9, ORIGINAL APPOINTMENT REQUEST DATE",.ERRCOUNT)
End DoDot:1
QUIT
+17 SET DGPAT("ORIGAPPREQTS")=$$CONVERT^DGENUPL1(SEG(10),"TS",.ERROR)
+18 IF ERROR
Begin DoDot:1
+19 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 10, ORIGINAL APPOINTMENT REQUEST CHG DT/TIME",.ERRCOUNT)
End DoDot:1
QUIT
+20 ; jam; DG*5.3*978 - begin various validations that are done to determine whether certain fields should be filed or dropped or an error sent back
+21 ; If not deleting ORIGINAL APPT REQUEST, Do not store Original Appt Request fields (1010.1512, 1010.1513, 1010.1514) if current value of field 1010.1512 in Vista is not blank
+22 IF DGPAT("ORIGAPPREQ")'="@"
Begin DoDot:1
+23 IF $$GET1^DIQ(2,DFN,1010.1512,"I")'=""
KILL DGPAT("ORIGAPPREQ"),DGPAT("ORIGAPPREQDT"),DGPAT("ORIGAPPREQTS")
End DoDot:1
+24 ;
+25 ;These are the rules for the other 1010 fields (1010.159, 1010.1511 and 1010.1515):
+26 ;
+27 ;Value of Value of 1010.159 Compare 1010.1515
+28 ;1010EZ field 1010EZ field with Z11 "APPREQTS"
+29 ;Incoming Z11 in Vista DB Which is more recent? Resulting Process
+30 ;------------------------------------------------------------------------------------------------------------------------
+31 ;1. YES/NO YES/NO Vista Ignore the ZIO 1010 fields - no error is sent, process the Z11
+32 ;2. NO YES Z11 Reject the Z11 - send error back
+33 ;3. All other cases --- --- File the fields
+34 ;
+35 ; Case 1: If the incoming Z11 appt request date/time change is not "@" and is older that the Vista date/time change,
+36 ; don't file the fields - we don't throw an error for these cases.
+37 IF DGPAT("APPREQTS")'="@"
IF DGPAT("APPREQTS")<$$GET1^DIQ(2,DFN,1010.1515,"I")
KILL DGPAT("APPREQTS"),DGPAT("APPREQ"),DGPAT("APPREQDT")
QUIT
+38 ; Case 2 - If not deleting Appt. Request, changing a YES in Vista to a NO is not allowed and an error is generated
+39 IF DGPAT("APPREQ")'="@"
IF (DGPAT("APPREQ")=0)&($$GET1^DIQ(2,DFN,1010.159,"I")=1)
Begin DoDot:1
+40 SET ERROR=1
+41 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST ON 1010EZ - VISTA VALUE IS YES",.ERRCOUNT)
End DoDot:1
QUIT
+42 ;
+43 ; last check - field 1010.1511 APPOINTMENT REQUEST DATE must not be a future date
+44 IF DGPAT("APPREQDT")>DT
Begin DoDot:1
+45 SET ERROR=1
+46 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST DATE - FUTURE DATE",.ERRCOUNT)
End DoDot:1
QUIT
+47 ; jam; DG*5.3*978 - end of validations - data can be filed.
+48 QUIT
+49 ;
ZPD ;
+1 SET DGELG("RATEINC")=$$CONVERT^DGENUPL1(SEG(8))
+2 SET DGPAT("DEATH")=$$CONVERT^DGENUPL1(SEG(9),"TS",.ERROR)
+3 IF ERROR
Begin DoDot:1
+4 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 9",.ERRCOUNT)
End DoDot:1
QUIT
+5 SET DGELG("MEDICAID")=$$CONVERT^DGENUPL1(SEG(12))
+6 SET DGELG("MEDASKDT")=$$CONVERT^DGENUPL1(SEG(13),"TS",.ERROR)
+7 IF ERROR
Begin DoDot:1
+8 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 13",.ERRCOUNT)
End DoDot:1
QUIT
+9 SET DGELG("POW")=$$CONVERT^DGENUPL1(SEG(17))
+10 SET DGPAT("SPININJ")=$$CONVERT^DGENUPL1(SEG(30))
+11 SET ERROR=$SELECT(DGPAT("SPININJ")="":0,",1,2,3,4,X,"[(","_DGPAT("SPININJ")_","):0,DGPAT("SPININJ")="@":0,1:1)
+12 IF ERROR
Begin DoDot:1
+13 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 30",.ERRCOUNT)
End DoDot:1
QUIT
+14 ;DG*5.3*688
+15 SET DGPAT("AG/ALLY")=$$CONVERT^DGENUPL1(SEG(35),"AGENCY",.ERROR)
+16 IF ERROR
Begin DoDot:1
+17 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 35",.ERRCOUNT)
End DoDot:1
+18 ;DG*5.3*677
SET DGPAT("EMGRES")=$$CONVERT^DGENUPL1(SEG(40))
+19 ; KUM - DG*5.3*1064
+20 SET DGPAT("INDID")=$$CONVERT^DGENUPL1(SEG(42),"Y/N",.ERROR)
+21 IF ERROR
Begin DoDot:1
+22 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("INDID")),"BAD VALUE, ZPD SEGMENT, SEQ 42",.ERRCOUNT)
End DoDot:1
+23 SET DGPAT("INDADT")=$$CONVERT^DGENUPL1(SEG(43),"DATE",.ERROR)
+24 IF ERROR
Begin DoDot:1
+25 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("INDADT")),"BAD VALUE, ZPD SEGMENT, SEQ 43",.ERRCOUNT)
End DoDot:1
+26 SET DGPAT("INDSDT")=$$CONVERT^DGENUPL1(SEG(44),"DATE",.ERROR)
+27 IF ERROR
Begin DoDot:1
+28 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("INDSDT")),"BAD VALUE, ZPD SEGMENT, SEQ 44",.ERRCOUNT)
End DoDot:1
+29 SET DGPAT("INDEDT")=$$CONVERT^DGENUPL1(SEG(45),"DATE",.ERROR)
+30 IF ERROR
Begin DoDot:1
+31 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("INDEDT")),"BAD VALUE, ZPD SEGMENT, SEQ 45",.ERRCOUNT)
End DoDot:1
+32 QUIT
+33 ;
SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
+1 ; pointer to file 4
+2 NEW SITE
+3 SET SITE=""
+4 IF STRING'=""
Begin DoDot:1
+5 NEW SUB,START,END
+6 ; Find site ien if only site # is returned
+7 IF $ORDER(^DIC(4,"D",STRING,0))
SET SITE=$ORDER(^DIC(4,"D",STRING,0))
QUIT
+8 ; Check if name is concatenated onto site # to find site ien
+9 SET SUB=""
+10 FOR
SET SUB=$ORDER(^DIC(4,"D",SUB))
if SUB=""
QUIT
IF $EXTRACT(SUB,1,3)=$EXTRACT(STRING,1,3)
IF $$CHK(SUB,STRING)
SET SITE=$ORDER(^DIC(4,"D",SUB,0))
QUIT
End DoDot:1
+11 ; SITE is the pointer to file 4 or null for site not found
+12 QUIT SITE
+13 ;
CHK(SUB,STRING) ;
+1 NEW IEN,X,STN,RET
+2 IF SUB=STRING
QUIT 1
+3 SET RET=0
+4 SET IEN=+$ORDER(^DIC(4,"D",SUB,""))
+5 IF IEN
Begin DoDot:1
+6 SET X=$PIECE($GET(^DIC(4,IEN,0)),U)
SET STN=$PIECE($GET(^(99)),U)
+7 ; assume institution file names will be the same on HEC and VistA
+8 IF STN=SUB
IF X'=""
IF $EXTRACT($PIECE(STRING,SUB,2,999),1,40)=X
SET RET=1
End DoDot:1
+9 QUIT RET
+10 ;
