- DGENUPL2 ;ALB/CJM,RTK,TMK,ISA/KWP/RMM/CKN,EG,ERC,PWC,TDM,TEJ,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 23 Nov 2019 1:07 PM
- ;;5.3;REGISTRATION;**147,222,232,310,314,367,397,677,631,675,672,673,716,653,688,838,842,894,934,940,993,1027**;Aug 13,1993;Build 70
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;**************************************************************
- ;The following procedures parse particular segment types.
- ;Input:SEG(),MSGID
- ;Output:DGPAT(),DGELG(),DGENR(),DGCDIS(),DGNTR(),DGOEIF(),ERROR
- ;**************************************************************
- ;
- PID ;
- S DGPAT("SSN")=SEG(19)
- Q
- ;
- ZPD ;
- D ZPD^DGENUPLA ;code removed due to size of DGENUPLA - DG*5.3*688
- Q
- ;
- ZIE ;
- S DGPAT("INELDATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZIE SEGMENT, SEQ 2",.ERRCOUNT)
- S DGPAT("INELREA")=$$CONVERT^DGENUPL1(SEG(3))
- S DGPAT("INELDEC")=$$CONVERT^DGENUPL1(SEG(4))
- Q
- ;
- ZIO ;New segment - DG*5.3*653
- D ZIO^DGENUPLA ;Code for ZIO has moved to DGENUPLA
- Q
- ;
- ZEL(COUNT) ;
- D ZEL^DGENUPLA(COUNT) ;code for ZEL segment has moved to DGENUPLA
- Q
- ;
- ZEN ;
- N SUB,DGRES
- S DGENR("DATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 2",.ERRCOUNT)
- S DGENR("SOURCE")=$$CONVERT^DGENUPL1(SEG(3))
- S DGENR("STATUS")=$$CONVERT^DGENUPL1(SEG(4))
- ;S ERROR=$$PEND(DFN,DGENR("STATUS")) ;DG*5.3*934
- S ERROR=0 ;DG*5.3*934
- ;I ERROR D Q ;DG*5.3*934
- ;.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ENROLLMENT STATUS PENDING-ELIGIBILITY IS VERIFIED",.ERRCOUNT)
- S DGENR("REASON")=$$CONVERT^DGENUPL1(SEG(5))
- S DGENR("REMARKS")=$$CONVERT^DGENUPL1(SEG(6))
- S DGENR("FACREC")=$$CONVERT^DGENUPL1(SEG(7),"INSTITUTION",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"FACILITY RECEIVED "_SEG(7)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- S DGPAT("PREFAC")=$$CONVERT^DGENUPL1(SEG(8),"INSTITUTION",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"PREFERRED FACILITY "_SEG(8)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- ;
- S DGENR("PRIORITY")=$$CONVERT^DGENUPL1(SEG(9))
- S DGENR("EFFDATE")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 10",.ERRCOUNT)
- S DGOAPP=""
- S DGENR("APP")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 11",.ERRCOUNT)
- ;DG*5.3*1027 - Capture Application Date tranmitted by ES for checking later
- S DGOAPP=DGENR("APP")
- I DGOAPP="@" S DGOAPP=""
- ;
- ;!!!!!! take next line out when HEC begins transmitting application dt
- I DGENR("APP")=""!(DGENR("APP")="@") S DGENR("APP")=DGENR("DATE")
- I DGENR("APP")=""!(DGENR("APP")="@") S DGENR("APP")=DGENR("EFFDATE")
- ;
- S DGENR("END")=$$CONVERT^DGENUPL1(SEG(12),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 12",.ERRCOUNT)
- ;Phase II Parse out Sub-Group (SRS 6[B.4)
- S DGENR("SUBGRP")=$$CONVERT^DGENUPL1(SEG(13))
- S DGPAT("PFSRC")=$$CONVERT^DGENUPL1(SEG(14)) N PFSRC S PFSRC=DGPAT("PFSRC")
- I PFSRC'="V"&(PFSRC'="E")&(PFSRC'="PA")&(PFSRC'="PI")&(PFSRC'="@")&(PFSRC'="") D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 14",.ERRCOUNT) Q
- ;
- S DGENR("RCODE")=$$CONVERT^DGENUPL1(SEG(15)) ;DJE field added with DG*5.3*940 - Closed Application - RM#867186
- S DGENR("PTAPPLIED")=$$CONVERT^DGENUPL1(SEG(16)) ;KUM field added with DG*5.3*993
- S DGENR("REGREA")=$$CONVERT^DGENUPL1(SEG(17)) ;KUM field added with DG*5.3*993
- S DGENR("REGREA")=$$FIND1^DIC(408.43,"","X",$G(DGENR("REGREA")),"C","","ERROR")
- I DGENR("REGREA")=0 S DGENR("REGREA")=""
- S DGENR("REGDATE")=$$CONVERT^DGENUPL1(SEG(18),"DATE",.ERROR) ;KUM field added with DG*5.3*993
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 18",.ERRCOUNT)
- S DGENR("REGSRC")=$$CONVERT^DGENUPL1(SEG(19)) ;KUM field added with DG*5.3*993
- I ((DGENR("REGSRC")'="")!(DGENR("REGSRC")'="@")) D
- . S DGRES=0
- . D CHK^DIE(27.11,.17,"",DGENR("REGSRC"),.DGRES)
- . I +DGRES>0 S DGENR("REGSRC")=DGRES
- ;DG*5.3*933
- ;Make Enrollment Application Date, Effective Date and Enrollment End Date as Registration date if it is blank for REGISTRAITON ONLY status
- I $G(DGENR("STATUS"))=25 D
- .I (($G(DGENR("REGDATE"))="")!($G(DGENR("REGDATE"))="@")) D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"REGISTRATION DATE IS MISSING AND ENROLLMENT STATUS IS REGISTRAITON ONLY",.ERRCOUNT)
- .I (($G(DGENR("APP"))="")!($G(DGENR("APP"))="@")) S DGENR("APP")=DGENR("REGDATE")
- .I (($G(DGENR("EFFDATE"))="")!($G(DGENR("EFFDATE"))="@")) S DGENR("EFFDATE")=DGENR("REGDATE")
- .I (($G(DGENR("SOURCE"))="")!($G(DGENR("SOURCE"))="@")) S DGENR("SOURCE")=2
- ;want to ignore double quotes sent for enrollment fields
- S SUB=""
- F S SUB=$O(DGENR(SUB)) Q:SUB="" I DGENR(SUB)="@"!(DGENR(SUB)="""""") S DGENR(SUB)=""
- ;
- Q
- ;
- ZMT ;
- I SEG(1)>1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ZMT SEGMENT, SEQ 1, SHOULD SPECIFY MEANS TEST",.ERRCOUNT) S ERROR=1 Q
- S DGELG("MTSTA")=$$CONVERT^DGENUPL1(SEG(3),"MT",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZMT SEGMENT, SEQ 3",.ERRCOUNT)
- Q
- ;
- ZCD ;
- ;Phase II for multiple ZCD's
- I SEG(1)>1 G SKIP
- S DGCDIS("BY")=$$CONVERT^DGENUPL1(SEG(3))
- S DGCDIS("DATE")=$$CONVERT^DGENUPL1(SEG(5),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 5",.ERRCOUNT)
- S DGCDIS("FACDET")=$$CONVERT^DGENUPL1(SEG(4),"INSTITUTION",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"FACILITY "_SEG(4)_" MAKING CATASTROPHIC DISABILITY DETERMINATION NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- S DGCDIS("REVDTE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 2",.ERRCOUNT)
- S DGCDIS("METDET")=$$CONVERT^DGENUPL1($P(SEG(6),$E(HLECH)))
- S DGCDIS("VCD")=$$CONVERT^DGENUPL1(SEG(12))
- ;SEQ 14 - DATE VETERAN REQUESTED CD EVALUATION
- S DGCDIS("VETREQDT")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 14",.ERRCOUNT)
- ;SEQ 15 - DATE FACILITY INITIATED REVIEW
- S DGCDIS("DTFACIRV")=$$CONVERT^DGENUPL1(SEG(15),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 15",.ERRCOUNT)
- ;SEQ 16 - DATE VETERAN WAS NOTIFIED
- S DGCDIS("DTVETNOT")=$$CONVERT^DGENUPL1(SEG(16),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 16",.ERRCOUNT)
- SKIP ;
- ;Phase II Parse out additional fields. CONVERT type of RSN converts the code to IEN for diagnosis,procedure and condition (HL7TORSN^DGENA5).
- ; * check the new DESCRIPTOR sequences - DG*5.3*894
- N I,D3 ; DG*5.3*894
- S D3="|" ; DG*5.3*894
- F I=1:1 Q:$P(SEG(17),D3,I)="" D
- . S DGCDIS("DESCR",I)=$$CONVERT^DGENUPL1($P(SEG(17),D3,I),"CDDSCR")
- ;
- I '$D(DGCDIS("DESCR")) D
- .S DGCDIS("DIAG",SEG(1))=$$CONVERT^DGENUPL1(SEG(7),"CDRSN")
- .S DGCDIS("PROC",SEG(1))=$$CONVERT^DGENUPL1(SEG(8),"CDRSN")
- .S DGCDIS("COND",SEG(1))=$$CONVERT^DGENUPL1(SEG(10),"CDRSN")
- ;
- S DGCDIS("EXT",SEG(1),1)=$$CONVERT^DGENUPL1($P(SEG(9),$E(HLECH)),"EXT")
- S DGCDIS("SCORE",SEG(1))=$$CONVERT^DGENUPL1($P(SEG(11),$E(HLECH)))
- S DGCDIS("PERM",SEG(1))=$$CONVERT^DGENUPL1($P(SEG(13),$E(HLECH)))
- I DGCDIS("VCD")="Y",'$D(DGCDIS("DIAG")),'$D(DGCDIS("PROC")),'$D(DGCDIS("COND")),'$D(DGCDIS("DESCR")) D Q
- .S ERROR=1 D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"NO VALID DIAGNOSIS,PROCEDURE,CONDITION, OR DESCRIPTOR IN THE ZCD SEGMENT",.ERRCOUNT)
- Q
- ;
- ZSP ;
- S DGELG("SC")=$$CONVERT^DGENUPL1(SEG(2),"Y/N",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 2",.ERRCOUNT)
- S DGELG("SCPER")=$$CONVERT^DGENUPL1(SEG(3))
- S DGELG("POS")=$$CONVERT^DGENUPL1(SEG(4),"POS",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 4",.ERRCOUNT)
- S DGELG("EFFDT")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
- I ERROR D Q
- . D ADDERROR^DGENUPL(MSGID,$G(DGELG("EFFDT")),"BAD VALUE, ZSP SEGMENT, SEQ 11",.ERRCOUNT)
- ;if effective date is null, set update value to "@" (delete)
- I DGELG("EFFDT")="" S DGELG("EFFDT")="@"
- ;
- ;added 8/3/98 to reduce #rejects
- ;if HEC sends SC=NO, SC% not sent, and site has value for SC% then delete it
- I DGELG("SC")="N",DGELG("SCPER")="" S DGELG("SCPER")="@"
- ;
- S DGELG("P&T")=$$CONVERT^DGENUPL1(SEG(6),"Y/N",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 6",.ERRCOUNT)
- S DGELG("UNEMPLOY")=$$CONVERT^DGENUPL1(SEG(7),"Y/N",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 7",.ERRCOUNT)
- S DGELG("SCAWDATE")=$$CONVERT^DGENUPL1(SEG(8),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 8",.ERRCOUNT)
- S DGELG("P&TDT")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR)
- I ERROR D
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 10 - P&T EFFECTIVE DATE",.ERRCOUNT)
- S DGPAT("DENTC2IN")=$$CONVERT^DGENUPL1(SEG(12),"Y/N",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 12",.ERRCOUNT)
- S DGPAT("DENTC2DT")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR)
- I ERROR D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 13",.ERRCOUNT)
- Q
- ;
- ZMH ;Purple Heart, OEFOIE, POW
- D ZMH^DGENUPL3 ;Moved to DGENUPL3 - DG*5.3*653
- Q
- ;
- ZRD ;
- N COUNT,DXCODE,NAME,COND
- S DXCODE=$P(SEG(2),$E(HLECH))
- I DXCODE="""""" S DXCODE=""
- S NAME=$P(SEG(2),$E(HLECH),2)
- Q:DXCODE="" ;segment does not contain a disability condition
- ;
- S COUNT=1+(+$G(DGELG("RATEDIS")))
- S (COND,DGELG("RATEDIS",COUNT,"RD"))=$$DCLOOKUP(DXCODE,NAME)
- S DGELG("RATEDIS",COUNT,"PER")=$$CONVERT^DGENUPL1(SEG(3)),DGELG("RATEDIS")=COUNT
- S DGELG("RATEDIS",COUNT,"RDEXT")=$$CONVERT^DGENUPL1(SEG(12))
- S DGELG("RATEDIS",COUNT,"RDORIG")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR)
- I ERROR D Q
- . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 13",.ERRCOUNT)
- S DGELG("RATEDIS",COUNT,"RDCURR")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR)
- I ERROR D Q
- . D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 14",.ERRCOUNT)
- I 'COND D Q
- .D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, SEQ 2 - DISABILTY CONDITION LOOKUP FAILED",.ERRCOUNT)
- .S ERROR=1
- Q
- OBX ;
- D OBX^DGENUPLA ;code for OBX segment moved to DGENUPLA
- Q
- ;
- ;*********** end of segment parsers ****
- ;
- DCLOOKUP(DGCODE,DGNAME) ;
- ; Description: Returns the ien of a Disability Condition (file #31) based on the DGCODE and DGNAME
- ;
- ;Input:
- ; DGCODE - DX Code of the Disability Condition
- ; DGNAME - name of the Disability Condition
- ;Output:
- ; Function Value: ien of the entry found, or 0 otherwise
- ;
- Q:(DGCODE="") 0
- N NODE,IEN,FOUND
- S (FOUND,IEN)=0
- F S IEN=$O(^DIC(31,"C",DGCODE,IEN)) Q:'IEN D Q:FOUND
- .S NODE=$G(^DIC(31,IEN,0))
- .I DGNAME=$P(NODE,"^"),DGCODE=$P(NODE,"^",3) S FOUND=1
- I 'FOUND S IEN=$O(^DIC(31,"C",DGCODE,0))
- Q +IEN
- ;
- REGCHECK(DFN) ;
- ; Description: passes patient through the registration consistency checker
- ;Input -
- ; DFN - is a pointer to the Patient File
- ;
- N DGCD,DGCHK,DGDAY,DGEDCN,DGER,DGLST,DGNCK,DGRPCOLD,DGSC,DGTYPE,DGVT,VA,X
- ;
- S DGEDCN=0
- D ^DGRPC
- Q
- PEND(DFN,DGSTAT) ;
- N DGARR,DGEC,DGERR,DGX
- I $P($G(^DPT(DFN,.361)),U)'="V" Q 0
- I $G(DGSTAT)="@" Q 0
- I $G(DGSTAT)']"" Q 0
- S DGSTAT="^"_DGSTAT_"^"
- Q:"^15^17^"'[DGSTAT 0
- D GETS^DIQ(2,DFN_",",".301;.302;.361;.36295","IE","DGARR","DGERR")
- I $D(DGERR) Q 0
- S DGEC=$G(DGARR(2,DFN_",",.361,"I"))
- I $G(DGEC)']"" Q 0
- S DGEC=$P($G(^DIC(8,DGEC,0)),U,9)
- I $G(DGEC)']"" Q 0
- I DGEC=5 Q 1
- I DGEC=3 D Q DGX
- . S DGX=1
- . I $G(DGARR(2,DFN_",",.301,"I"))'="Y" S DGX=0 Q
- . I +$G(DGARR(2,DFN_",",.302,"I"))>0 S DGX=0 Q
- . I +$G(DGARR(2,DFN_",",.36295,"I"))>0 S DGX=0 Q
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENUPL2 12310 printed Feb 19, 2025@00:09:21 Page 2
- DGENUPL2 ;ALB/CJM,RTK,TMK,ISA/KWP/RMM/CKN,EG,ERC,PWC,TDM,TEJ,KUM - PROCESS INCOMING (Z11 EVENT TYPE) HL7 MESSAGES ; 23 Nov 2019 1:07 PM
- +1 ;;5.3;REGISTRATION;**147,222,232,310,314,367,397,677,631,675,672,673,716,653,688,838,842,894,934,940,993,1027**;Aug 13,1993;Build 70
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;**************************************************************
- +5 ;The following procedures parse particular segment types.
- +6 ;Input:SEG(),MSGID
- +7 ;Output:DGPAT(),DGELG(),DGENR(),DGCDIS(),DGNTR(),DGOEIF(),ERROR
- +8 ;**************************************************************
- +9 ;
- PID ;
- +1 SET DGPAT("SSN")=SEG(19)
- +2 QUIT
- +3 ;
- ZPD ;
- +1 ;code removed due to size of DGENUPLA - DG*5.3*688
- DO ZPD^DGENUPLA
- +2 QUIT
- +3 ;
- ZIE ;
- +1 SET DGPAT("INELDATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- +2 IF ERROR
- Begin DoDot:1
- +3 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZIE SEGMENT, SEQ 2",.ERRCOUNT)
- End DoDot:1
- QUIT
- +4 SET DGPAT("INELREA")=$$CONVERT^DGENUPL1(SEG(3))
- +5 SET DGPAT("INELDEC")=$$CONVERT^DGENUPL1(SEG(4))
- +6 QUIT
- +7 ;
- ZIO ;New segment - DG*5.3*653
- +1 ;Code for ZIO has moved to DGENUPLA
- DO ZIO^DGENUPLA
- +2 QUIT
- +3 ;
- ZEL(COUNT) ;
- +1 ;code for ZEL segment has moved to DGENUPLA
- DO ZEL^DGENUPLA(COUNT)
- +2 QUIT
- +3 ;
- ZEN ;
- +1 NEW SUB,DGRES
- +2 SET DGENR("DATE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- +3 IF ERROR
- Begin DoDot:1
- +4 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 2",.ERRCOUNT)
- End DoDot:1
- QUIT
- +5 SET DGENR("SOURCE")=$$CONVERT^DGENUPL1(SEG(3))
- +6 SET DGENR("STATUS")=$$CONVERT^DGENUPL1(SEG(4))
- +7 ;S ERROR=$$PEND(DFN,DGENR("STATUS")) ;DG*5.3*934
- +8 ;DG*5.3*934
- SET ERROR=0
- +9 ;I ERROR D Q ;DG*5.3*934
- +10 ;.D ADDERROR^DGENUPL(MSGID,$G(DGPAT("SSN")),"ENROLLMENT STATUS PENDING-ELIGIBILITY IS VERIFIED",.ERRCOUNT)
- +11 SET DGENR("REASON")=$$CONVERT^DGENUPL1(SEG(5))
- +12 SET DGENR("REMARKS")=$$CONVERT^DGENUPL1(SEG(6))
- +13 SET DGENR("FACREC")=$$CONVERT^DGENUPL1(SEG(7),"INSTITUTION",.ERROR)
- +14 IF ERROR
- Begin DoDot:1
- +15 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"FACILITY RECEIVED "_SEG(7)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- End DoDot:1
- QUIT
- +16 SET DGPAT("PREFAC")=$$CONVERT^DGENUPL1(SEG(8),"INSTITUTION",.ERROR)
- +17 IF ERROR
- Begin DoDot:1
- +18 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"PREFERRED FACILITY "_SEG(8)_" NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- End DoDot:1
- QUIT
- +19 ;
- +20 SET DGENR("PRIORITY")=$$CONVERT^DGENUPL1(SEG(9))
- +21 SET DGENR("EFFDATE")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR)
- +22 IF ERROR
- Begin DoDot:1
- +23 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 10",.ERRCOUNT)
- End DoDot:1
- QUIT
- +24 SET DGOAPP=""
- +25 SET DGENR("APP")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
- +26 IF ERROR
- Begin DoDot:1
- +27 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 11",.ERRCOUNT)
- End DoDot:1
- QUIT
- +28 ;DG*5.3*1027 - Capture Application Date tranmitted by ES for checking later
- +29 SET DGOAPP=DGENR("APP")
- +30 IF DGOAPP="@"
- SET DGOAPP=""
- +31 ;
- +32 ;!!!!!! take next line out when HEC begins transmitting application dt
- +33 IF DGENR("APP")=""!(DGENR("APP")="@")
- SET DGENR("APP")=DGENR("DATE")
- +34 IF DGENR("APP")=""!(DGENR("APP")="@")
- SET DGENR("APP")=DGENR("EFFDATE")
- +35 ;
- +36 SET DGENR("END")=$$CONVERT^DGENUPL1(SEG(12),"DATE",.ERROR)
- +37 IF ERROR
- Begin DoDot:1
- +38 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 12",.ERRCOUNT)
- End DoDot:1
- QUIT
- +39 ;Phase II Parse out Sub-Group (SRS 6[B.4)
- +40 SET DGENR("SUBGRP")=$$CONVERT^DGENUPL1(SEG(13))
- +41 SET DGPAT("PFSRC")=$$CONVERT^DGENUPL1(SEG(14))
- NEW PFSRC
- SET PFSRC=DGPAT("PFSRC")
- +42 IF PFSRC'="V"&(PFSRC'="E")&(PFSRC'="PA")&(PFSRC'="PI")&(PFSRC'="@")&(PFSRC'="")
- DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 14",.ERRCOUNT)
- QUIT
- +43 ;
- +44 ;DJE field added with DG*5.3*940 - Closed Application - RM#867186
- SET DGENR("RCODE")=$$CONVERT^DGENUPL1(SEG(15))
- +45 ;KUM field added with DG*5.3*993
- SET DGENR("PTAPPLIED")=$$CONVERT^DGENUPL1(SEG(16))
- +46 ;KUM field added with DG*5.3*993
- SET DGENR("REGREA")=$$CONVERT^DGENUPL1(SEG(17))
- +47 SET DGENR("REGREA")=$$FIND1^DIC(408.43,"","X",$GET(DGENR("REGREA")),"C","","ERROR")
- +48 IF DGENR("REGREA")=0
- SET DGENR("REGREA")=""
- +49 ;KUM field added with DG*5.3*993
- SET DGENR("REGDATE")=$$CONVERT^DGENUPL1(SEG(18),"DATE",.ERROR)
- +50 IF ERROR
- Begin DoDot:1
- +51 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZEN SEGMENT, SEQ 18",.ERRCOUNT)
- End DoDot:1
- QUIT
- +52 ;KUM field added with DG*5.3*993
- SET DGENR("REGSRC")=$$CONVERT^DGENUPL1(SEG(19))
- +53 IF ((DGENR("REGSRC")'="")!(DGENR("REGSRC")'="@"))
- Begin DoDot:1
- +54 SET DGRES=0
- +55 DO CHK^DIE(27.11,.17,"",DGENR("REGSRC"),.DGRES)
- +56 IF +DGRES>0
- SET DGENR("REGSRC")=DGRES
- End DoDot:1
- +57 ;DG*5.3*933
- +58 ;Make Enrollment Application Date, Effective Date and Enrollment End Date as Registration date if it is blank for REGISTRAITON ONLY status
- +59 IF $GET(DGENR("STATUS"))=25
- Begin DoDot:1
- +60 IF (($GET(DGENR("REGDATE"))="")!($GET(DGENR("REGDATE"))="@"))
- DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"REGISTRATION DATE IS MISSING AND ENROLLMENT STATUS IS REGISTRAITON ONLY",.ERRCOUNT)
- +61 IF (($GET(DGENR("APP"))="")!($GET(DGENR("APP"))="@"))
- SET DGENR("APP")=DGENR("REGDATE")
- +62 IF (($GET(DGENR("EFFDATE"))="")!($GET(DGENR("EFFDATE"))="@"))
- SET DGENR("EFFDATE")=DGENR("REGDATE")
- +63 IF (($GET(DGENR("SOURCE"))="")!($GET(DGENR("SOURCE"))="@"))
- SET DGENR("SOURCE")=2
- End DoDot:1
- +64 ;want to ignore double quotes sent for enrollment fields
- +65 SET SUB=""
- +66 FOR
- SET SUB=$ORDER(DGENR(SUB))
- if SUB=""
- QUIT
- IF DGENR(SUB)="@"!(DGENR(SUB)="""""")
- SET DGENR(SUB)=""
- +67 ;
- +68 QUIT
- +69 ;
- ZMT ;
- +1 IF SEG(1)>1
- DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"ZMT SEGMENT, SEQ 1, SHOULD SPECIFY MEANS TEST",.ERRCOUNT)
- SET ERROR=1
- QUIT
- +2 SET DGELG("MTSTA")=$$CONVERT^DGENUPL1(SEG(3),"MT",.ERROR)
- +3 IF ERROR
- Begin DoDot:1
- +4 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZMT SEGMENT, SEQ 3",.ERRCOUNT)
- End DoDot:1
- QUIT
- +5 QUIT
- +6 ;
- ZCD ;
- +1 ;Phase II for multiple ZCD's
- +2 IF SEG(1)>1
- GOTO SKIP
- +3 SET DGCDIS("BY")=$$CONVERT^DGENUPL1(SEG(3))
- +4 SET DGCDIS("DATE")=$$CONVERT^DGENUPL1(SEG(5),"DATE",.ERROR)
- +5 IF ERROR
- Begin DoDot:1
- +6 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 5",.ERRCOUNT)
- End DoDot:1
- QUIT
- +7 SET DGCDIS("FACDET")=$$CONVERT^DGENUPL1(SEG(4),"INSTITUTION",.ERROR)
- +8 IF ERROR
- Begin DoDot:1
- +9 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"FACILITY "_SEG(4)_" MAKING CATASTROPHIC DISABILITY DETERMINATION NOT FOUND IN THE INSTITUTION FILE",.ERRCOUNT)
- End DoDot:1
- QUIT
- +10 SET DGCDIS("REVDTE")=$$CONVERT^DGENUPL1(SEG(2),"DATE",.ERROR)
- +11 IF ERROR
- Begin DoDot:1
- +12 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 2",.ERRCOUNT)
- End DoDot:1
- QUIT
- +13 SET DGCDIS("METDET")=$$CONVERT^DGENUPL1($PIECE(SEG(6),$EXTRACT(HLECH)))
- +14 SET DGCDIS("VCD")=$$CONVERT^DGENUPL1(SEG(12))
- +15 ;SEQ 14 - DATE VETERAN REQUESTED CD EVALUATION
- +16 SET DGCDIS("VETREQDT")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR)
- +17 IF ERROR
- Begin DoDot:1
- +18 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 14",.ERRCOUNT)
- End DoDot:1
- QUIT
- +19 ;SEQ 15 - DATE FACILITY INITIATED REVIEW
- +20 SET DGCDIS("DTFACIRV")=$$CONVERT^DGENUPL1(SEG(15),"DATE",.ERROR)
- +21 IF ERROR
- Begin DoDot:1
- +22 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 15",.ERRCOUNT)
- End DoDot:1
- QUIT
- +23 ;SEQ 16 - DATE VETERAN WAS NOTIFIED
- +24 SET DGCDIS("DTVETNOT")=$$CONVERT^DGENUPL1(SEG(16),"DATE",.ERROR)
- +25 IF ERROR
- Begin DoDot:1
- +26 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZCD SEGMENT, SEQ 16",.ERRCOUNT)
- End DoDot:1
- QUIT
- SKIP ;
- +1 ;Phase II Parse out additional fields. CONVERT type of RSN converts the code to IEN for diagnosis,procedure and condition (HL7TORSN^DGENA5).
- +2 ; * check the new DESCRIPTOR sequences - DG*5.3*894
- +3 ; DG*5.3*894
- NEW I,D3
- +4 ; DG*5.3*894
- SET D3="|"
- +5 FOR I=1:1
- if $PIECE(SEG(17),D3,I)=""
- QUIT
- Begin DoDot:1
- +6 SET DGCDIS("DESCR",I)=$$CONVERT^DGENUPL1($PIECE(SEG(17),D3,I),"CDDSCR")
- End DoDot:1
- +7 ;
- +8 IF '$DATA(DGCDIS("DESCR"))
- Begin DoDot:1
- +9 SET DGCDIS("DIAG",SEG(1))=$$CONVERT^DGENUPL1(SEG(7),"CDRSN")
- +10 SET DGCDIS("PROC",SEG(1))=$$CONVERT^DGENUPL1(SEG(8),"CDRSN")
- +11 SET DGCDIS("COND",SEG(1))=$$CONVERT^DGENUPL1(SEG(10),"CDRSN")
- End DoDot:1
- +12 ;
- +13 SET DGCDIS("EXT",SEG(1),1)=$$CONVERT^DGENUPL1($PIECE(SEG(9),$EXTRACT(HLECH)),"EXT")
- +14 SET DGCDIS("SCORE",SEG(1))=$$CONVERT^DGENUPL1($PIECE(SEG(11),$EXTRACT(HLECH)))
- +15 SET DGCDIS("PERM",SEG(1))=$$CONVERT^DGENUPL1($PIECE(SEG(13),$EXTRACT(HLECH)))
- +16 IF DGCDIS("VCD")="Y"
- IF '$DATA(DGCDIS("DIAG"))
- IF '$DATA(DGCDIS("PROC"))
- IF '$DATA(DGCDIS("COND"))
- IF '$DATA(DGCDIS("DESCR"))
- Begin DoDot:1
- +17 SET ERROR=1
- DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"NO VALID DIAGNOSIS,PROCEDURE,CONDITION, OR DESCRIPTOR IN THE ZCD SEGMENT",.ERRCOUNT)
- End DoDot:1
- QUIT
- +18 QUIT
- +19 ;
- ZSP ;
- +1 SET DGELG("SC")=$$CONVERT^DGENUPL1(SEG(2),"Y/N",.ERROR)
- +2 IF ERROR
- Begin DoDot:1
- +3 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 2",.ERRCOUNT)
- End DoDot:1
- QUIT
- +4 SET DGELG("SCPER")=$$CONVERT^DGENUPL1(SEG(3))
- +5 SET DGELG("POS")=$$CONVERT^DGENUPL1(SEG(4),"POS",.ERROR)
- +6 IF ERROR
- Begin DoDot:1
- +7 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 4",.ERRCOUNT)
- End DoDot:1
- QUIT
- +8 SET DGELG("EFFDT")=$$CONVERT^DGENUPL1(SEG(11),"DATE",.ERROR)
- +9 IF ERROR
- Begin DoDot:1
- +10 DO ADDERROR^DGENUPL(MSGID,$GET(DGELG("EFFDT")),"BAD VALUE, ZSP SEGMENT, SEQ 11",.ERRCOUNT)
- End DoDot:1
- QUIT
- +11 ;if effective date is null, set update value to "@" (delete)
- +12 IF DGELG("EFFDT")=""
- SET DGELG("EFFDT")="@"
- +13 ;
- +14 ;added 8/3/98 to reduce #rejects
- +15 ;if HEC sends SC=NO, SC% not sent, and site has value for SC% then delete it
- +16 IF DGELG("SC")="N"
- IF DGELG("SCPER")=""
- SET DGELG("SCPER")="@"
- +17 ;
- +18 SET DGELG("P&T")=$$CONVERT^DGENUPL1(SEG(6),"Y/N",.ERROR)
- +19 IF ERROR
- Begin DoDot:1
- +20 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 6",.ERRCOUNT)
- End DoDot:1
- QUIT
- +21 SET DGELG("UNEMPLOY")=$$CONVERT^DGENUPL1(SEG(7),"Y/N",.ERROR)
- +22 IF ERROR
- Begin DoDot:1
- +23 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 7",.ERRCOUNT)
- End DoDot:1
- QUIT
- +24 SET DGELG("SCAWDATE")=$$CONVERT^DGENUPL1(SEG(8),"DATE",.ERROR)
- +25 IF ERROR
- Begin DoDot:1
- +26 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 8",.ERRCOUNT)
- End DoDot:1
- QUIT
- +27 SET DGELG("P&TDT")=$$CONVERT^DGENUPL1(SEG(10),"DATE",.ERROR)
- +28 IF ERROR
- Begin DoDot:1
- +29 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 10 - P&T EFFECTIVE DATE",.ERRCOUNT)
- End DoDot:1
- +30 SET DGPAT("DENTC2IN")=$$CONVERT^DGENUPL1(SEG(12),"Y/N",.ERROR)
- +31 IF ERROR
- Begin DoDot:1
- +32 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 12",.ERRCOUNT)
- End DoDot:1
- QUIT
- +33 SET DGPAT("DENTC2DT")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR)
- +34 IF ERROR
- Begin DoDot:1
- +35 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZSP SEGMENT, SEQ 13",.ERRCOUNT)
- End DoDot:1
- QUIT
- +36 QUIT
- +37 ;
- ZMH ;Purple Heart, OEFOIE, POW
- +1 ;Moved to DGENUPL3 - DG*5.3*653
- DO ZMH^DGENUPL3
- +2 QUIT
- +3 ;
- ZRD ;
- +1 NEW COUNT,DXCODE,NAME,COND
- +2 SET DXCODE=$PIECE(SEG(2),$EXTRACT(HLECH))
- +3 IF DXCODE=""""""
- SET DXCODE=""
- +4 SET NAME=$PIECE(SEG(2),$EXTRACT(HLECH),2)
- +5 ;segment does not contain a disability condition
- if DXCODE=""
- QUIT
- +6 ;
- +7 SET COUNT=1+(+$GET(DGELG("RATEDIS")))
- +8 SET (COND,DGELG("RATEDIS",COUNT,"RD"))=$$DCLOOKUP(DXCODE,NAME)
- +9 SET DGELG("RATEDIS",COUNT,"PER")=$$CONVERT^DGENUPL1(SEG(3))
- SET DGELG("RATEDIS")=COUNT
- +10 SET DGELG("RATEDIS",COUNT,"RDEXT")=$$CONVERT^DGENUPL1(SEG(12))
- +11 SET DGELG("RATEDIS",COUNT,"RDORIG")=$$CONVERT^DGENUPL1(SEG(13),"DATE",.ERROR)
- +12 IF ERROR
- Begin DoDot:1
- +13 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 13",.ERRCOUNT)
- End DoDot:1
- QUIT
- +14 SET DGELG("RATEDIS",COUNT,"RDCURR")=$$CONVERT^DGENUPL1(SEG(14),"DATE",.ERROR)
- +15 IF ERROR
- Begin DoDot:1
- +16 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, S 14",.ERRCOUNT)
- End DoDot:1
- QUIT
- +17 IF 'COND
- Begin DoDot:1
- +18 DO ADDERROR^DGENUPL(MSGID,$GET(DGPAT("SSN")),"BAD VALUE, ZRD SEGMENT, SEQ 2 - DISABILTY CONDITION LOOKUP FAILED",.ERRCOUNT)
- +19 SET ERROR=1
- End DoDot:1
- QUIT
- +20 QUIT
- OBX ;
- +1 ;code for OBX segment moved to DGENUPLA
- DO OBX^DGENUPLA
- +2 QUIT
- +3 ;
- +4 ;*********** end of segment parsers ****
- +5 ;
- DCLOOKUP(DGCODE,DGNAME) ;
- +1 ; Description: Returns the ien of a Disability Condition (file #31) based on the DGCODE and DGNAME
- +2 ;
- +3 ;Input:
- +4 ; DGCODE - DX Code of the Disability Condition
- +5 ; DGNAME - name of the Disability Condition
- +6 ;Output:
- +7 ; Function Value: ien of the entry found, or 0 otherwise
- +8 ;
- +9 if (DGCODE="")
- QUIT 0
- +10 NEW NODE,IEN,FOUND
- +11 SET (FOUND,IEN)=0
- +12 FOR
- SET IEN=$ORDER(^DIC(31,"C",DGCODE,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +13 SET NODE=$GET(^DIC(31,IEN,0))
- +14 IF DGNAME=$PIECE(NODE,"^")
- IF DGCODE=$PIECE(NODE,"^",3)
- SET FOUND=1
- End DoDot:1
- if FOUND
- QUIT
- +15 IF 'FOUND
- SET IEN=$ORDER(^DIC(31,"C",DGCODE,0))
- +16 QUIT +IEN
- +17 ;
- REGCHECK(DFN) ;
- +1 ; Description: passes patient through the registration consistency checker
- +2 ;Input -
- +3 ; DFN - is a pointer to the Patient File
- +4 ;
- +5 NEW DGCD,DGCHK,DGDAY,DGEDCN,DGER,DGLST,DGNCK,DGRPCOLD,DGSC,DGTYPE,DGVT,VA,X
- +6 ;
- +7 SET DGEDCN=0
- +8 DO ^DGRPC
- +9 QUIT
- PEND(DFN,DGSTAT) ;
- +1 NEW DGARR,DGEC,DGERR,DGX
- +2 IF $PIECE($GET(^DPT(DFN,.361)),U)'="V"
- QUIT 0
- +3 IF $GET(DGSTAT)="@"
- QUIT 0
- +4 IF $GET(DGSTAT)']""
- QUIT 0
- +5 SET DGSTAT="^"_DGSTAT_"^"
- +6 if "^15^17^"'[DGSTAT
- QUIT 0
- +7 DO GETS^DIQ(2,DFN_",",".301;.302;.361;.36295","IE","DGARR","DGERR")
- +8 IF $DATA(DGERR)
- QUIT 0
- +9 SET DGEC=$GET(DGARR(2,DFN_",",.361,"I"))
- +10 IF $GET(DGEC)']""
- QUIT 0
- +11 SET DGEC=$PIECE($GET(^DIC(8,DGEC,0)),U,9)
- +12 IF $GET(DGEC)']""
- QUIT 0
- +13 IF DGEC=5
- QUIT 1
- +14 IF DGEC=3
- Begin DoDot:1
- +15 SET DGX=1
- +16 IF $GET(DGARR(2,DFN_",",.301,"I"))'="Y"
- SET DGX=0
- QUIT
- +17 IF +$GET(DGARR(2,DFN_",",.302,"I"))>0
- SET DGX=0
- QUIT
- +18 IF +$GET(DGARR(2,DFN_",",.36295,"I"))>0
- SET DGX=0
- QUIT
- End DoDot:1
- QUIT DGX
- +19 QUIT 0