DGENUPL9 ;ISA/KWP,JAN,BRM,PJR,LBD,TDM,KUM - CD CONSISTENCY CHECKS ; 8/18/08 9:23am
;;5.3;REGISTRATION;**232,378,451,564,628,688,1018**;Aug 13,1993;Build 5
;
CDCHECK() ;
;Description: Does the consistency checks on the CATASTROPHIC DISABILITY objects.
;Input:
; MSGS -Error messages
; DGPAT -Patient array
; MSGID -HL7 Message ID
; OLDCDIS -CD array with data from file
; DGCDIS -CD Array
; ERRCOUNT -number of errors
;Output:
; 1 if consistency checks passed, 0 otherwise
;
; VistA Changes (DG*5.3*451) added CCs listed below in place of the
; previous Consistency Checks based on new business rules.
;
N CDERR
; Reject CD update if required fields are missing
I DGCDIS("VCD")="Y",'$$CHECK^DGENCDA1(.DGCDIS,.CDERR) D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"CD Error: "_CDERR,.ERRCOUNT) Q 0
;
; If CD is Yes on VISTA and update is Yes and the current Date of
; Decision is more recent than the incoming one, reject update.
I OLDCDIS("VCD")="Y",DGCDIS("VCD")="Y",DGCDIS("DATE")<OLDCDIS("DATE") D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"CD Error: Date of Decision is more recent at site",.ERRCOUNT) Q 0
;
; CD evaluation of 'NO' shall not overwrite a CD evaluation of
; 'YES' unless it is from the originating site.
I OLDCDIS("VCD")="Y",DGCDIS("VCD")="N",OLDCDIS("FACDET")'=DGCDIS("FACDET") Q 0 ;no error message when this occurs per bus. rules
;
Q 1
AO ;Agent Orange Exp. Location - overflow code from MERGE^DGENUPL4
I DGELG("AO")'="" D
. I DGELG("AO")="Y",$G(DGELG("AOEXPLOC"))'="" Q ;Added DG*5.3*688
. ;I DGELG("AO")="Y",OLDELG("AOEXPLOC")="" D ;Commented DG*5.3*1018
. ;. S DGELG3("AOEXPLOC")="V" D BULLETIN ;Commented DG*5.3*1018
. I DGELG("AO")="N",OLDELG("AOEXPLOC")'="" D
. . S DGELG3("AOEXPLOC")="@" D BULLETIN
Q
BULLETIN ;Agent Orange Exposure Location Change
; >> this function has been removed based on a customer request
; >> the code is being left for reactivation if desired w/ ESR
Q
N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
Q:'DGMGRP
D XMY^DGMTUTL(DGMGRP,0,1)
S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
S XMTEXT="DGBULL("
S XMSUB="AGENT ORANGE EXPOSURE LOCATION CHANGE"
S DGLINE=0
D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
D LINE^DGEN("",.DGLINE)
D LINE^DGEN("This veteran's Agent Orange Exposure Location has been changed.",.DGLINE)
D LINE^DGEN("Contact the HEC by phone if you have questions or believe",.DGLINE)
D LINE^DGEN("this information to be incorrect.",.DGLINE)
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENUPL9 2663 printed Sep 23, 2025@20:19:16 Page 2
DGENUPL9 ;ISA/KWP,JAN,BRM,PJR,LBD,TDM,KUM - CD CONSISTENCY CHECKS ; 8/18/08 9:23am
+1 ;;5.3;REGISTRATION;**232,378,451,564,628,688,1018**;Aug 13,1993;Build 5
+2 ;
CDCHECK() ;
+1 ;Description: Does the consistency checks on the CATASTROPHIC DISABILITY objects.
+2 ;Input:
+3 ; MSGS -Error messages
+4 ; DGPAT -Patient array
+5 ; MSGID -HL7 Message ID
+6 ; OLDCDIS -CD array with data from file
+7 ; DGCDIS -CD Array
+8 ; ERRCOUNT -number of errors
+9 ;Output:
+10 ; 1 if consistency checks passed, 0 otherwise
+11 ;
+12 ; VistA Changes (DG*5.3*451) added CCs listed below in place of the
+13 ; previous Consistency Checks based on new business rules.
+14 ;
+15 NEW CDERR
+16 ; Reject CD update if required fields are missing
+17 IF DGCDIS("VCD")="Y"
IF '$$CHECK^DGENCDA1(.DGCDIS,.CDERR)
DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"CD Error: "_CDERR,.ERRCOUNT)
QUIT 0
+18 ;
+19 ; If CD is Yes on VISTA and update is Yes and the current Date of
+20 ; Decision is more recent than the incoming one, reject update.
+21 IF OLDCDIS("VCD")="Y"
IF DGCDIS("VCD")="Y"
IF DGCDIS("DATE")<OLDCDIS("DATE")
DO ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"CD Error: Date of Decision is more recent at site",.ERRCOUNT)
QUIT 0
+22 ;
+23 ; CD evaluation of 'NO' shall not overwrite a CD evaluation of
+24 ; 'YES' unless it is from the originating site.
+25 ;no error message when this occurs per bus. rules
IF OLDCDIS("VCD")="Y"
IF DGCDIS("VCD")="N"
IF OLDCDIS("FACDET")'=DGCDIS("FACDET")
QUIT 0
+26 ;
+27 QUIT 1
AO ;Agent Orange Exp. Location - overflow code from MERGE^DGENUPL4
+1 IF DGELG("AO")'=""
Begin DoDot:1
+2 ;Added DG*5.3*688
IF DGELG("AO")="Y"
IF $GET(DGELG("AOEXPLOC"))'=""
QUIT
+3 ;I DGELG("AO")="Y",OLDELG("AOEXPLOC")="" D ;Commented DG*5.3*1018
+4 ;. S DGELG3("AOEXPLOC")="V" D BULLETIN ;Commented DG*5.3*1018
+5 IF DGELG("AO")="N"
IF OLDELG("AOEXPLOC")'=""
Begin DoDot:2
+6 SET DGELG3("AOEXPLOC")="@"
DO BULLETIN
End DoDot:2
End DoDot:1
+7 QUIT
BULLETIN ;Agent Orange Exposure Location Change
+1 ; >> this function has been removed based on a customer request
+2 ; >> the code is being left for reactivation if desired w/ ESR
+3 QUIT
+4 NEW DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
+5 SET DGMGRP=$ORDER(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
+6 if 'DGMGRP
QUIT
+7 DO XMY^DGMTUTL(DGMGRP,0,1)
+8 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
SET DGSSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
+9 SET XMTEXT="DGBULL("
+10 SET XMSUB="AGENT ORANGE EXPOSURE LOCATION CHANGE"
+11 SET DGLINE=0
+12 DO LINE^DGEN("Patient: "_DGNAME,.DGLINE)
+13 DO LINE^DGEN("SSN: "_DGSSN,.DGLINE)
+14 DO LINE^DGEN("",.DGLINE)
+15 DO LINE^DGEN("This veteran's Agent Orange Exposure Location has been changed.",.DGLINE)
+16 DO LINE^DGEN("Contact the HEC by phone if you have questions or believe",.DGLINE)
+17 DO LINE^DGEN("this information to be incorrect.",.DGLINE)
+18 DO ^XMD
+19 QUIT
