| 1 | DGENUPL9 ;ISA/KWP,JAN,BRM,PJR,LBD - CD CONSISTENCY CHECKS ; 10/13/04 2:39pm
|
|---|
| 2 | ;;5.3;REGISTRATION;**232,378,451,564,628**;Aug 13,1993
|
|---|
| 3 | ;
|
|---|
| 4 | CDCHECK() ;
|
|---|
| 5 | ;Description: Does the consistency checks on the CATASTROPHIC DISABILITY objects.
|
|---|
| 6 | ;Input:
|
|---|
| 7 | ; MSGS -Error messages
|
|---|
| 8 | ; DGPAT -Patient array
|
|---|
| 9 | ; MSGID -HL7 Message ID
|
|---|
| 10 | ; OLDCDIS -CD array with data from file
|
|---|
| 11 | ; DGCDIS -CD Array
|
|---|
| 12 | ; ERRCOUNT -number of errors
|
|---|
| 13 | ;Output:
|
|---|
| 14 | ; 1 if consistency checks passed, 0 otherwise
|
|---|
| 15 | ;
|
|---|
| 16 | ; VistA Changes (DG*5.3*451) added CCs listed below in place of the
|
|---|
| 17 | ; previous Consistency Checks based on new business rules.
|
|---|
| 18 | ;
|
|---|
| 19 | N CDERR
|
|---|
| 20 | ; Reject CD update if required fields are missing
|
|---|
| 21 | I DGCDIS("VCD")="Y",'$$CHECK^DGENCDA1(.DGCDIS,.CDERR) D ADDERROR^DGENUPL(MSGID,DGPAT("SSN"),"CD Error: "_CDERR,.ERRCOUNT) Q 0
|
|---|
| 22 | ;
|
|---|
| 23 | ; If CD is Yes on VISTA and update is Yes and the current Date of
|
|---|
| 24 | ; Decision is more recent than the incoming one, reject update.
|
|---|
| 25 | 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
|
|---|
| 26 | ;
|
|---|
| 27 | ; CD evaluation of 'NO' shall not overwrite a CD evaluation of
|
|---|
| 28 | ; 'YES' unless it is from the originating site.
|
|---|
| 29 | I OLDCDIS("VCD")="Y",DGCDIS("VCD")="N",OLDCDIS("FACDET")'=DGCDIS("FACDET") Q 0 ;no error message when this occurs per bus. rules
|
|---|
| 30 | ;
|
|---|
| 31 | Q 1
|
|---|
| 32 | AO ;Agent Orange Exp. Location - overflow code from MERGE^DGENUPL4
|
|---|
| 33 | I DGELG("AO")'="" D
|
|---|
| 34 | . I DGELG("AO")="Y",OLDELG("AOEXPLOC")="" D
|
|---|
| 35 | . . S DGELG3("AOEXPLOC")="V" D BULLETIN
|
|---|
| 36 | . I DGELG("AO")="N",OLDELG("AOEXPLOC")'="" D
|
|---|
| 37 | . . S DGELG3("AOEXPLOC")="@" D BULLETIN
|
|---|
| 38 | Q
|
|---|
| 39 | BULLETIN ;Agent Orange Exposure Location Change
|
|---|
| 40 | ; >> this function has been removed based on a customer request
|
|---|
| 41 | ; >> the code is being left for reactivation if desired w/ ESR
|
|---|
| 42 | Q
|
|---|
| 43 | N DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
|
|---|
| 44 | S DGMGRP=$O(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
|
|---|
| 45 | Q:'DGMGRP
|
|---|
| 46 | D XMY^DGMTUTL(DGMGRP,0,1)
|
|---|
| 47 | S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^DPT(DFN,0)),"^",9)
|
|---|
| 48 | S XMTEXT="DGBULL("
|
|---|
| 49 | S XMSUB="AGENT ORANGE EXPOSURE LOCATION CHANGE"
|
|---|
| 50 | S DGLINE=0
|
|---|
| 51 | D LINE^DGEN("Patient: "_DGNAME,.DGLINE)
|
|---|
| 52 | D LINE^DGEN("SSN: "_DGSSN,.DGLINE)
|
|---|
| 53 | D LINE^DGEN("",.DGLINE)
|
|---|
| 54 | D LINE^DGEN("This veteran's Agent Orange Exposure Location has been changed.",.DGLINE)
|
|---|
| 55 | D LINE^DGEN("Contact the HEC by phone if you have questions or believe",.DGLINE)
|
|---|
| 56 | D LINE^DGEN("this information to be incorrect.",.DGLINE)
|
|---|
| 57 | D ^XMD
|
|---|
| 58 | Q
|
|---|
