DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 7/28/09 2:41pm
;;5.3;PIMS;**397,379,497,451,564,672,659,583,653,688,1015,1016**;JUN 30, 2012;Build 20
;
;***************************************************************
; 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)))
.S ERROR=$S(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,"[(","_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)
. 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)
;
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)
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
Q
;
SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
; ptr 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
;
DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 7/28/09 2:41pm
+1 ;;5.3;PIMS;**397,379,497,451,564,672,659,583,653,688,1015,1016**;JUN 30, 2012;Build 20
+2 ;
+3 ;***************************************************************
+4 ; This routine was created because DGENUPL2 had reached it's
+5 ; maximum size, therefore no new code could not be added. All
+6 ; code that existed in the ZEL and OBX tags of DGENUPL2 has
+7 ; been moved to the ZEL,ZPD and OBX tags of DGENUPLA. A line of code
+8 ; was placed in ZEL^DGENUPL2 to call ZEL^DGENUPLA. A line of
+9 ; code was placed in OBX^DGENUPL2 to call OBX^DGENUPLA.
+10 ; Any routine that calls ZEL,ZPD or OBX^DGENUPL2 will not
+11 ; be affected by this change.
+12 ;***************************************************************
+13 ;
+14 ;***************************************************************
+15 ;The following procedures parse particular segment types.
+16 ;Input:SEG(),MSGID
+17 ;Output:DGPAT(),DGELG(),DGENR(),DGNTR(),DGMST(),ERROR
+18 ;***************************************************************
+19 ;
+20 ;
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 SET ERROR=$SELECT(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,"[(","_DGELG("RADEXPM")_","):0,DGELG("RADEXPM")="@":0,1:1)
+45 IF ERROR
Begin DoDot:2
+46 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
End DoDot:2
QUIT
+47 ;
+48 SET DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
+49 ;
+50 ;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
+51 FOR SEQ=23,24,25
IF SEG(SEQ)=HLQ
SET SEG(SEQ)=""
+52 SET DGMST("MSTSTAT")=$$CONVERT^DGENUPL1(SEG(23))
+53 SET DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
+54 IF ERROR
Begin DoDot:2
+55 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
End DoDot:2
QUIT
+56 SET DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
+57 IF ERROR
Begin DoDot:2
+58 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
End DoDot:2
QUIT
+59 ;
+60 SET DGELG("AOEXPLOC")=$$CONVERT^DGENUPL1(SEG(29))
+61 ; Logic enhanced during SQA of patch 451. AOERR from SEG(18) above.
+62 IF 'AOERR
IF DGELG("AO")'="Y"
IF DGELG("AOEXPLOC")=""
SET DGELG("AOEXPLOC")="@"
+63 SET DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
+64 IF ERROR
Begin DoDot:2
+65 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
End DoDot:2
QUIT
+66 SET DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
+67 IF ERROR
Begin DoDot:2
+68 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
End DoDot:2
QUIT
+69 SET DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
+70 IF ERROR
Begin DoDot:2
+71 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
End DoDot:2
QUIT
+72 ;Discharge due to Disability - DG*5.3*653
IF $GET(DGELG("DISLOD"))=""
SET DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR)
+73 IF ERROR
Begin DoDot:2
+74 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
End DoDot:2
QUIT
+75 ;Proj 112/SHAD - DG*5.3*653
SET DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR)
+76 IF ERROR
Begin DoDot:2
+77 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
End DoDot:2
QUIT
End DoDot:1
+78 ;
+79 IF COUNT>1
Begin DoDot:1
+80 SET DGELG("ELIG","CODE",CODE)=""
End DoDot:1
+81 QUIT
+82 ;
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 QUIT
+8 ;
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 QUIT
+20 ;
SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
+1 ; ptr 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 ;
