DGENUPL9.m

DGENUPL9 ;ISA/KWP,JAN,BRM,PJR,LBD,TDM - CD CONSISTENCY CHECKS ; 8/18/08 9:23am

 ;;5.3;PIMS;**232,378,451,564,628,1015,1016**;JUN 30, 2012;Build 20

 ;

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

 . . S DGELG3("AOEXPLOC")="V" D BULLETIN

 . 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

DGENUPL9  ;ISA/KWP,JAN,BRM,PJR,LBD,TDM - CD CONSISTENCY CHECKS ; 8/18/08 9:23am

 +1       ;;5.3;PIMS;**232,378,451,564,628,1015,1016**;JUN 30, 2012;Build 20

 +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                IF DGELG("AO")="Y"

                       IF OLDELG("AOEXPLOC")=""

                           Begin DoDot:2

 +4                            SET DGELG3("AOEXPLOC")="V"

                               DO BULLETIN

                           End DoDot:2

 +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