Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENUPLA

DGENUPLA.m

Go to the documentation of this file.
DGENUPLA ;ALB/CKN,TDM,PJR,RGL,EG,TMK,CKN,TDM,JAM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ;23 Feb 2017  11:30 AM
 ;;5.3;REGISTRATION;**397,379,497,451,564,672,659,583,653,688,754,909,978,952**;Aug 13,1993;Build 160
 ;
 ;***************************************************************
 ; 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)
 .; 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))
 .; 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
 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
 ;