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. 
  1. 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
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ;***************************************************************
  1.  ; This routine was created because DGENUPL2 had reached it's
  1.  ; maximum size, therefore no new code could not be added.  All
  1.  ; code that existed in the ZEL and OBX tags of DGENUPL2 has
  1.  ; been moved to the ZEL,ZPD and OBX tags of DGENUPLA.  A line of code
  1.  ; was placed in ZEL^DGENUPL2 to call ZEL^DGENUPLA.  A line of
  1.  ; code was placed in OBX^DGENUPL2 to call OBX^DGENUPLA.
  1.  ; Any routine that calls ZEL,ZPD or OBX^DGENUPL2 will not
  1.  ; be affected by this change.
  1.  ;***************************************************************
  1.  ;
  1.  ;***************************************************************
  1.  ;The following procedures parse particular segment types.
  1.  ;Input:SEG(),MSGID
  1.  ;Output:DGPAT(),DGELG(),DGENR(),DGNTR(),DGMST(),ERROR
  1.  ;***************************************************************
  1.  ;
  1.  ;
  1. ZEL(COUNT) ;
  1.  N CODE,SEQ
  1.  S CODE=$$CONVERT^DGENUPL1(SEG(2),"ELIGIBILITY",.ERROR)
  1.  I ERROR D  Q
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ELIGIBILITY CODE "_SEG(2)_" NOT FOUND IN ELIGIBILTIY CODE FILE",.ERRCOUNT)
  1.  I COUNT=1 D
  1.  .S DGELG("ELIG","CODE")=CODE
  1.  .S DGELG("DISRET")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 5",.ERRCOUNT)
  1.  .S DGELG("CLAIMNUM")=$$CONVERT^DGENUPL1(SEG(6))
  1.  .S DGELG("CLAIMLOC")=$$SITECNV(SEG(7))
  1.  .;
  1.  .S DGPAT("VETERAN")=$$CONVERT^DGENUPL1(SEG(8),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 8",.ERRCOUNT)
  1.  .S DGELG("ELIGSTA")=$$CONVERT^DGENUPL1(SEG(10))
  1.  .S DGELG("ELIGSTADATE")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 11",.ERRCOUNT)
  1.  .S DGELG("ELIGVERIF")=$$CONVERT^DGENUPL1(SEG(13))
  1.  .S DGELG("A&A")=$$CONVERT^DGENUPL1(SEG(14),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 14",.ERRCOUNT)
  1.  .S DGELG("HB")=$$CONVERT^DGENUPL1(SEG(15),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 15",.ERRCOUNT)
  1.  .S DGELG("VAPEN")=$$CONVERT^DGENUPL1(SEG(16),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 16",.ERRCOUNT)
  1.  .S DGELG("VADISAB")=$$CONVERT^DGENUPL1(SEG(17),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 17",.ERRCOUNT)
  1.  .S DGELG("AO")=$$CONVERT^DGENUPL1(SEG(18),"Y/N",.ERROR)
  1.  .N AOERR S AOERR=ERROR            ;  See SEG(29) below.
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 18",.ERRCOUNT)
  1.  .S (DGPAT("IR"),DGELG("IR"))=$$CONVERT^DGENUPL1(SEG(19),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 19",.ERRCOUNT)
  1.  .S DGELG("EC")=$$CONVERT^DGENUPL1(SEG(20),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 20",.ERRCOUNT)
  1.  .S (DGPAT("RADEXPM"),DGELG("RADEXPM"))=$$CONVERT^DGENUPL1($G(SEG(22)))
  1.  .;DG*5.3*1090 - Add 8,9,10
  1.  .S ERROR=$S(DGELG("RADEXPM")="":0,",2,3,4,5,6,7,8,9,10,"[(","_DGELG("RADEXPM")_","):0,DGELG("RADEXPM")="@":0,1:1)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 22",.ERRCOUNT)
  1.  .;
  1.  .S DGELG("VACKAMT")=$$CONVERT^DGENUPL1(SEG(21))
  1.  .;
  1.  .;Parse MST data into DGMST array from sequences 23, 24, 25 of ZEL segment
  1.  .F SEQ=23,24,25 S:SEG(SEQ)=HLQ SEG(SEQ)=""
  1.  .S DGMST("MSTSTAT")=$$CONVERT^DGENUPL1(SEG(23))
  1.  .S DGMST("MSTDT")=$$CONVERT^DGENUPL1(SEG(24),"TS",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 24",.ERRCOUNT)
  1.  .S DGMST("MSTST")=$$CONVERT^DGENUPL1(SEG(25),"INSTITUTION",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 25",.ERRCOUNT)
  1.  .;
  1.  .S DGELG("AOEXPLOC")=$$CONVERT^DGENUPL1(SEG(29))
  1.  .; Logic enhanced during SQA of patch 451.  AOERR from SEG(18) above.
  1.  .I 'AOERR,DGELG("AO")'="Y",DGELG("AOEXPLOC")="" S DGELG("AOEXPLOC")="@"
  1.  .S DGELG("UEYEAR")=$$CONVERT^DGENUPL1(SEG(34),"DATE",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 34",.ERRCOUNT)
  1.  .S DGELG("UESITE")=$$CONVERT^DGENUPL1(SEG(35),"INSTITUTION",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 35",.ERRCOUNT)
  1.  .S DGELG("CVELEDT")=$$CONVERT^DGENUPL1(SEG(38),"DATE",.ERROR)
  1.  .;DG*5.3*1090 - Populate the source in ^TMP global
  1.  .S ^TMP("DGCVE",$J,"COMBAT VET ELIG END DATE SOURCE",DFN)="ES"
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 38",.ERRCOUNT)
  1.  .I $G(DGELG("DISLOD"))="" S DGELG("DISLOD")=$$CONVERT^DGENUPL1(SEG(39),"1/0",.ERROR) ;Discharge due to Disability - DG*5.3*653
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 39",.ERRCOUNT)
  1.  .S DGELG("SHAD")=$$CONVERT^DGENUPL1(SEG(40),"1/0",.ERROR) ;Proj 112/SHAD - DG*5.3*653
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 40 - SHAD Indicator",.ERRCOUNT)
  1.  .; Camp Lejeune data checking added - DG*5.3*909
  1.  .S DGELG("CLE")=$$CONVERT^DGENUPL1(SEG(41),"Y/N",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 41",.ERRCOUNT)
  1.  .S DGELG("CLEDT")=$$CONVERT^DGENUPL1(SEG(42),"DATE",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 42",.ERRCOUNT)
  1.  .S DGELG("CLEST")=$$CONVERT^DGENUPL1(SEG(43))
  1.  .S DGELG("CLESOR")=$$CONVERT^DGENUPL1(SEG(44))
  1.  .; DG*5.3*1103 - Parse Toxic Exposure Risk Activity (TERA) field into DGPAT array
  1.  .S ERROR=0
  1.  .S DGPAT("TERA")=$$CONVERT^DGENUPL1($G(SEG(48)))
  1.  .I ((DGPAT("TERA")'=0)&(DGPAT("TERA")'=1)) S ERROR=1
  1.  .I ((DGPAT("TERA")="")!(DGPAT("TERA")="@")) S ERROR=0
  1.  .I (DGPAT("TERA"))="" K DGPAT("TERA")
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 48",.ERRCOUNT)
  1.  .;DG*5.3*1121 - Parse Persian Gulf Indicator field and Last change date field into DGPAT("PGULF") and DGPAT("PGULFTS") array
  1.  .S ERROR=0
  1.  .S DGPAT("PGULF")=$$CONVERT^DGENUPL1($G(SEG(49)))
  1.  .I ((DGPAT("PGULF")'=0)&(DGPAT("PGULF")'=1)) S ERROR=1
  1.  .I ((DGPAT("PGULF")="")!(DGPAT("PGULF")="@")) S ERROR=0
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 49",.ERRCOUNT)
  1.  .S ERROR=0
  1.  .S DGPAT("PGULFTS")=$$CONVERT^DGENUPL1(SEG(50),"TS",.ERROR)
  1.  .I ERROR D  Q
  1.  ..D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEL SEGMENT, SEQ 50",.ERRCOUNT)
  1.  .; OTH data DG*5.3*952
  1.  .I COUNT=1 D
  1.  ..S DGELG("OTH")=$$CONVERT^DGENUPL1($G(SEG(45)))
  1.  ..S DGELG("OTHTYPE")=$$CONVERT^DGENUPL1($G(SEG(46)))
  1.  ..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
  1.  ..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
  1.  ..S DGELG("OTHTYPE")=$S(DGELG("OTHTYPE")=1:"OTH-90",DGELG("OTHTYPE")=2:"OTH-EXT",1:"")
  1.  ..; make sure that timestamp in ZEL.47 is not older than last timestamp in sub-file 33.02
  1.  ..I $$GET1^DIQ(8,CODE_",",.01)="EXPANDED MH CARE NON-ENROLLEE",$$GET1^DIQ(2,DFN_",",.361)="EXPANDED MH CARE NON-ENROLLEE" D
  1.  ...; primary eligibility is "EXPANDED MH CARE NON-ENROLLEE" in both Z11 and VistA
  1.  ...I DGELG("OTHTYPE")="OTH-90",$$GET1^DIQ(2,DFN_",",.5501,"I")="OTH-EXT" D
  1.  ....; OTH care type is OTH-90 in Z11, but is OTH-EXT in VistA
  1.  ....I $$FMDIFF^XLFDT(DGELG("OTHTS"),$$GETTIMST^DGOTHEL(DFN),2)<0 D
  1.  .....; local timestamp in 33.02 is more recent than one in ZEL.47
  1.  .....S ERROR=1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"MH CARE TYPE IS OTH-EXT AND IS MORE RECENT IN VISTA",.ERRCOUNT)
  1.  .....Q
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  I COUNT>1 D
  1.  .S DGELG("ELIG","CODE",CODE)=""
  1.  Q
  1.  ;
  1. OBX ;
  1.  N OBXPCE,OBXVAL,OBXTBL,I,CS,SS,RS
  1.  I $G(HLECH)'="~|\&" N HLECH S HLECH="~|\&"
  1.  I $G(HLFS)="" N HLFS S HLFS="^"
  1.  S CS=$E(HLECH,1),SS=$E(HLECH,4),RS=$E(HLECH,2)
  1.  I $G(SEG(3))=("38.1"_$E(HLECH)_"SECURITY LOG") D
  1.  . N LEVEL
  1.  . S LEVEL=$P(SEG(5),$E(HLECH))
  1.  . S DGSEC("LEVEL")=$$CONVERT^DGENUPL1(LEVEL,"1/0",.ERROR)
  1.  . I ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 5",.ERRCOUNT)
  1.  . S DGSEC("DATETIME")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
  1.  . I ERROR D  Q
  1.  . . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, OBX SEGMENT, SEQ 14, Patient Sensitivity Date/Time",.ERRCOUNT) ;DG*5.3*653
  1.  . S DGSEC("SOURCE")=$$CONVERT^DGENUPL1(SEG(16))
  1.  ;
  1.  I $G(SEG(3))=("VISTA"_CS_"28.11") D
  1.  . S OBXTBL(1)="NTR^Y",OBXTBL(2)="AVI^Y",OBXTBL(3)="SUB^Y"
  1.  . S OBXTBL(4)="HNC^Y",OBXTBL(5)="NTR^N",OBXTBL(6)="AVI^N"
  1.  . S OBXTBL(7)="SUB^N",OBXTBL(8)="HNC^N",OBXTBL(9)="NTR^U"
  1.  . F I=1:1:$L($G(SEG(5)),RS) D
  1.  . . S OBXPCE=$P($G(SEG(5)),RS,I),OBXVAL=$P($G(OBXPCE),CS)
  1.  . . S DGNTR($P($G(OBXTBL(OBXVAL)),"^"))=$P($G(OBXTBL(OBXVAL)),"^",2)
  1.  . I $G(SEG(12))'="" S DGNTR("HDT")=$$CONVERT^DGENUPL1(SEG(12),"TS",.ERROR)
  1.  . S DGNTR("VDT")=$$CONVERT^DGENUPL1(SEG(14),"TS",.ERROR)
  1.  . S DGNTR("VSIT")=$$CONVERT^DGENUPL1(SEG(15),"INSTITUTION",.ERROR)
  1.  . S DGNTR("HSIT")=$P($P($G(SEG(16)),CS,14),SS,2)
  1.  . I DGNTR("HSIT")'="" S DGNTR("HSIT")=$$CONVERT^DGENUPL1($G(DGNTR("HSIT")),"INSTITUTION",.ERROR)
  1.  . S DGNTR("VER")=$$CONVERT^DGENUPL1($P($G(SEG(17)),CS))
  1.  Q
  1.  ;
  1. ZIO ;New segment - DG*5.3*653
  1.  S DGPAT("APPREQ")=$$CONVERT^DGENUPL1(SEG(5),"1/0",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 5, APPOINTMENT REQUEST ON 1010EZ",.ERRCOUNT)
  1.  S DGPAT("APPREQDT")=$$CONVERT^DGENUPL1(SEG(6),"DATE",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST DATE",.ERRCOUNT)
  1.  ; jam; DG*5.3*978 - segments 7-10 added
  1.  S DGPAT("APPREQTS")=$$CONVERT^DGENUPL1(SEG(7),"TS",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST ON 1010EZ CHG DATE/TIME",.ERRCOUNT)
  1.  S DGPAT("ORIGAPPREQ")=$$CONVERT^DGENUPL1(SEG(8),"1/0",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 8, ORIGINAL APPOINTMENT REQUEST",.ERRCOUNT)
  1.  S DGPAT("ORIGAPPREQDT")=$$CONVERT^DGENUPL1(SEG(9),"DATE",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 9, ORIGINAL APPOINTMENT REQUEST DATE",.ERRCOUNT)
  1.  S DGPAT("ORIGAPPREQTS")=$$CONVERT^DGENUPL1(SEG(10),"TS",.ERROR)
  1.  I ERROR D  Q
  1.  . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 10, ORIGINAL APPOINTMENT REQUEST CHG DT/TIME",.ERRCOUNT)
  1.  ; 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
  1.  ; 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
  1.  I DGPAT("ORIGAPPREQ")'="@" D
  1.  . I $$GET1^DIQ(2,DFN,1010.1512,"I")'="" K DGPAT("ORIGAPPREQ"),DGPAT("ORIGAPPREQDT"),DGPAT("ORIGAPPREQTS")
  1.  ;
  1.  ;These are the rules for the other 1010 fields (1010.159, 1010.1511 and 1010.1515):
  1.  ;
  1.  ;Value of           Value of 1010.159    Compare 1010.1515 
  1.  ;1010EZ field         1010EZ field       with Z11 "APPREQTS"  
  1.  ;Incoming Z11          in Vista DB       Which is more recent?      Resulting Process
  1.  ;------------------------------------------------------------------------------------------------------------------------
  1.  ;1. YES/NO              YES/NO                 Vista                Ignore the ZIO 1010 fields - no error is sent, process the Z11
  1.  ;2. NO                  YES                    Z11                  Reject the Z11 - send error back
  1.  ;3. All other cases     ---                    ---                  File the fields
  1.  ;
  1.  ; Case 1: If the incoming Z11 appt request date/time change is not "@" and is older that the Vista date/time change, 
  1.  ;  don't file the fields - we don't throw an error for these cases.
  1.  I DGPAT("APPREQTS")'="@",DGPAT("APPREQTS")<$$GET1^DIQ(2,DFN,1010.1515,"I") K DGPAT("APPREQTS"),DGPAT("APPREQ"),DGPAT("APPREQDT") Q
  1.  ; Case 2 - If not deleting Appt. Request, changing a YES in Vista to a NO is not allowed and an error is generated
  1.  I DGPAT("APPREQ")'="@",(DGPAT("APPREQ")=0)&($$GET1^DIQ(2,DFN,1010.159,"I")=1) D  Q
  1.  .S ERROR=1
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 6, APPOINTMENT REQUEST ON 1010EZ - VISTA VALUE IS YES",.ERRCOUNT)
  1.  ; 
  1.  ; last check - field 1010.1511 APPOINTMENT REQUEST DATE must not be a future date
  1.  I DGPAT("APPREQDT")>DT D  Q
  1.  .S ERROR=1
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIO SEGMENT, SEQ 7, APPOINTMENT REQUEST DATE - FUTURE DATE",.ERRCOUNT)
  1.  ; jam; DG*5.3*978 - end of validations - data can be filed.
  1.  Q
  1.  ;
  1. ZPD ;
  1.  S DGELG("RATEINC")=$$CONVERT^DGENUPL1(SEG(8))
  1.  S DGPAT("DEATH")=$$CONVERT^DGENUPL1(SEG(9),"TS",.ERROR)
  1.  I ERROR D  Q
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 9",.ERRCOUNT)
  1.  S DGELG("MEDICAID")=$$CONVERT^DGENUPL1(SEG(12))
  1.  S DGELG("MEDASKDT")=$$CONVERT^DGENUPL1(SEG(13),"TS",.ERROR)
  1.  I ERROR D  Q
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 13",.ERRCOUNT)
  1.  S DGELG("POW")=$$CONVERT^DGENUPL1(SEG(17))
  1.  S DGPAT("SPININJ")=$$CONVERT^DGENUPL1(SEG(30))
  1.  S ERROR=$S(DGPAT("SPININJ")="":0,",1,2,3,4,X,"[(","_DGPAT("SPININJ")_","):0,DGPAT("SPININJ")="@":0,1:1)
  1.  I ERROR D  Q
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 30",.ERRCOUNT)
  1.  ;DG*5.3*688
  1.  S DGPAT("AG/ALLY")=$$CONVERT^DGENUPL1(SEG(35),"AGENCY",.ERROR)
  1.  I ERROR D
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZPD SEGMENT, SEQ 35",.ERRCOUNT)
  1.  S DGPAT("EMGRES")=$$CONVERT^DGENUPL1(SEG(40)) ;DG*5.3*677
  1.  ; KUM - DG*5.3*1064
  1.  S DGPAT("INDID")=$$CONVERT^DGENUPL1(SEG(42),"Y/N",.ERROR)
  1.  I ERROR D
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDID")),"BAD VALUE, ZPD SEGMENT, SEQ 42",.ERRCOUNT)
  1.  S DGPAT("INDADT")=$$CONVERT^DGENUPL1(SEG(43),"DATE",.ERROR)
  1.  I ERROR D
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDADT")),"BAD VALUE, ZPD SEGMENT, SEQ 43",.ERRCOUNT)
  1.  S DGPAT("INDSDT")=$$CONVERT^DGENUPL1(SEG(44),"DATE",.ERROR)
  1.  I ERROR D
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDSDT")),"BAD VALUE, ZPD SEGMENT, SEQ 44",.ERRCOUNT)
  1.  S DGPAT("INDEDT")=$$CONVERT^DGENUPL1(SEG(45),"DATE",.ERROR)
  1.  I ERROR D
  1.  .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("INDEDT")),"BAD VALUE, ZPD SEGMENT, SEQ 45",.ERRCOUNT)
  1.  Q
  1.  ;
  1. SITECNV(STRING) ; Convert claim folder loc (site # or site # and name) to
  1.  ; pointer to file 4
  1.  N SITE
  1.  S SITE=""
  1.  I STRING'="" D
  1.  . N SUB,START,END
  1.  . ; Find site ien if only site # is returned
  1.  . I $O(^DIC(4,"D",STRING,0)) S SITE=$O(^DIC(4,"D",STRING,0)) Q
  1.  . ; Check if name is concatenated onto site # to find site ien
  1.  . S SUB=""
  1.  . 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
  1.  ; SITE is the pointer to file 4 or null for site not found
  1.  Q SITE
  1.  ;
  1. CHK(SUB,STRING) ;
  1.  N IEN,X,STN,RET
  1.  I SUB=STRING Q 1
  1.  S RET=0
  1.  S IEN=+$O(^DIC(4,"D",SUB,""))
  1.  I IEN D
  1.  . S X=$P($G(^DIC(4,IEN,0)),U),STN=$P($G(^(99)),U)
  1.  . ; assume institution file names will be the same on HEC and VistA
  1.  . I STN=SUB,X'="",$E($P(STRING,SUB,2,999),1,40)=X S RET=1
  1.  Q RET
  1.  ;