- DGENA3 ;ALB/CJM,ISA,KWP,RTK,TDM,LBD,PHH,PJR,TDM,KUM,JAM - Enrollment API - Consistency check ;03/23/20 12:41pm
- ;;5.3;Registration;**232,306,327,367,417,454,456,491,514,451,808,993,1027,1111**;Aug 13,1993;Build 18
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;CHECKand TESTVAL moved from DGENA1
- CHECK(DGENR,DGPAT,ERRMSG) ;
- ; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED. Comment below modified to reflect this.
- ;Phase II consistency checks do not include INACTIVE(3),DEFERRED(4),SUSPENDED(5),EXPIRED(8),PENDING(9) enrollment statuses. References to these statuses have been removed.
- ;Description: Does validation checks on the enrollment contained in the
- ; DGENR array.
- ;Input:
- ; DGENR - this local array contains an enrollment and should be passed
- ; by reference
- ; DGPAT - this local array contains the patient object, it is optional
- ; If not passed,the database is referenced. (pass by reference)
- ;Output:
- ; Function Value - returns 1 if all validation checks passed, 0
- ; otherwise
- ; ERRMSG - if the consistency checks fail, an error msg is returned (pass by reference)
- N VALID,DGELGSUB,SUB,PRIGRP
- S VALID=0
- S ERRMSG=""
- D ;drops out of block if invalid condition found
- .I '$G(DGENR("DFN")) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
- .I '$D(^DPT(DGENR("DFN"),0)) S ERRMSG="PATIENT NOT FOUND IN DATABASE" Q
- .;if it points to a prior record, the DFN must match
- .I DGENR("PRIORREC") D Q:(ERRMSG'="")
- ..N DFN
- ..S DFN=$P($G(^DGEN(27.11,DGENR("PRIORREC"),0)),"^",2)
- ..I DFN,DFN'=DGENR("DFN") S ERRMSG="PATIENT'S PRIOR ENROLLMENT BELONGS TO ANOTHER PATIENT"
- .;check for required fields
- .F SUB="APP","SOURCE","STATUS","EFFDATE" I $G(DGENR(SUB))="" S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS MISSING" Q
- .Q:(ERRMSG'="")
- .;if the enrollment priority is present, it must be correct
- .M DGELGSUB=DGENR("ELIG")
- .;Phase II if the enrollment priority is present it must be correct based on the eligibility factors (SRS 6.5.1.2 d)
- .; ** temporarily commented out for HVE Phase II and III **
- .;I DGENR("PRIORITY") D Q:(ERRMSG'="")
- .;.S PRIGRP=$$PRI^DGENELA4(DGENR("ELIG","CODE"),.DGELGSUB,DGENR("DATE"),$G(DGENR("APP")))
- .;.;check priority
- .;.I DGENR("STATUS")=6 Q ; do not check priority for deceased
- .;.I DGENR("PRIORITY")'=$P(PRIGRP,"^") D Q
- .;..I $G(DGCDIS("VCD"))'="" Q
- .;..S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
- .;.;check subgroup if priority = 7 or 8
- .;.Q:DGENR("PRIORITY")<7
- .;.; sub-priority "e" can be overridden with "a" at HEC
- .;.I "^1^1^5^5^1^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
- .;.; sub-priority "g" can be overridden with "c" at HEC
- .;.I "^3^3^7^7^3^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
- .;.S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
- .; end of temporary comments
- .;
- .; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.
- .;Phase II require priority if status is VERIFIED(2),DEFERRED-INITIAL APP(14),DEFERRED-FISCAL YEAR(11),DEFERRED-MIDCYCLE(12),DEFERRED-STOP ENROLL(13),DEFERRED-BELOW EGT THRESHOLD(22) (SRS 6.5.1.2 b)
- .I (DGENR("STATUS")=2)!(DGENR("STATUS")=14)!(DGENR("STATUS")=11)!(DGENR("STATUS")=12)!(DGENR("STATUS")=13)!(DGENR("STATUS")=22),DGENR("PRIORITY")="" D Q
- ..S ERRMSG="ENROLLMENT PRIORITY IS REQUIRED WITH ENROLLMENT STATUSES: VERIFIED,DEFERRED-INITIAL APPLICATION BY VAMC,DEFERRED-FISCAL YEAR,DEFERRED-MID-CYCLE,DEFERRED-STOP NEW ENROLLMENTS,DEFERRED-BELOW EGT"
- .;Phase II require enrollment date when status is verified(2)(SRS 6.5.1.2 d)
- .I DGENR("STATUS")=2,DGENR("DATE")="" S ERRMSG="ENROLLMENT DATE IS REQUIRED WHEN STATUS IS VERIFIED" Q
- .;Phase II if enrollment date present with statuses other than verified then veteran must be previously VERIFIED(2) and enrolled (SRS 6.5.1.2 d)
- .N CURIEN S CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))
- .I DGENR("DATE"),DGENR("DATE")'="@",DGENR("STATUS")'=2,'CURIEN S ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED AND THE VETERAN WAS NOT PREVIOUSLY ENROLLED." Q
- .I DGENR("DATE"),DGENR("DATE")'="@",DGENR("STATUS")'=2,CURIEN,$P($G(^DGEN(27.11,CURIEN,0)),"^",4)'=2 S ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED WAS PREVIOUSLY ENROLLED BUT THE PREVIOUS STATUS WAS NOT VERIFIED." Q
- .;if status is not CANCELED/DECLINED, the REASON field should be ""
- .I (DGENR("STATUS")'=7),DGENR("REASON") S ERRMSG="ENROLLMENT STATUS OF OTHER THAN CANCELED/DECLINED IS INCONSISTENT WITH REASON CANCELED/DECLINED" Q
- .;if not an eligible vet, enrollment must not have status of VERIFIED, or UNVERIFIED
- .;if status is CANCELED/DECLINED, then reason is required
- .I (DGENR("STATUS")=7),'DGENR("REASON") S ERRMSG="STATUS OF CANCELED/DECLINED REQUIRES REASON" Q
- .;if status is DECEASED and Date of Death is missing, send bulletin
- .; This bulletin has been disabled. DG*5.3*808
- .;I DGENR("STATUS")=6 D
- .;.I $D(DGPAT),'DGPAT("DEATH") D BULLETIN
- .;.I '$D(DGPAT),'$$DEATH^DGENPTA(DGENR("DFN")) D BULLETIN
- .Q:(ERRMSG'="")
- .;certain statuses not allowed for a dead patient
- .I $D(DGPAT),DGPAT("DEATH"),(DGENR("STATUS")=1)!(DGENR("STATUS")=2) S ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT" Q
- .I '$D(DGPAT),$$DEATH^DGENPTA(DGENR("DFN")),(DGENR("STATUS")=1)!(DGENR("STATUS")=2) S ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT" Q
- .;all the field values must be valid
- .S SUB="" F S SUB=$O(DGENR(SUB)) Q:((ERRMSG'="")!(SUB="")) D
- ..;DG*5.3*1027 - Skip Validity check for Application Date if ES transmits Blank
- ..I SUB="APP",$G(DGOAPP)="" Q
- ..;
- ..I SUB'="ELIG",(SUB'="DATE"),(SUB'="FACREC") I '$$TESTVAL(SUB,DGENR(SUB)) S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
- .Q:(ERRMSG'="")
- .S SUB="" F S SUB=$O(DGENR("ELIG",SUB)) Q:((ERRMSG'="")!(SUB="")) D
- ..I '$$TESTVAL(SUB,DGENR("ELIG",SUB)) S ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
- .;if this point is reached it's valid
- .S VALID=1
- Q VALID
- TESTVAL(SUB,VAL) ;
- ;Description: returns 1 if VAL is a valid value for subscript SUB
- N DISPLAY,FIELD,RESULT,VALID
- S VALID=1
- I (VAL'="") D
- .S FIELD=$$FIELD^DGENU(SUB)
- .;if there is no external value then it is not valid
- .S DISPLAY=$$EXTERNAL^DILFD(27.11,FIELD,"F",VAL)
- .I (DISPLAY="") S VALID=0 Q
- .I $$GET1^DID(27.11,FIELD,"","TYPE")'="POINTER" D
- ..D CHK^DIE(27.11,FIELD,,VAL,.RESULT) I RESULT="^" S VALID=0 Q
- Q VALID
- BULLETIN ; Status vs. Date of Death Data Discrepancy Bulletin
- ; This bulletin has been disabled. DG*5.3*808
- 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="STATUS VS. DATE OF DEATH DATA DISCREPANCY"
- 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 Enrollment Status is Deceased,",.DGLINE)
- D LINE^DGEN("however, there is no Date of Death on file for VistA.",.DGLINE)
- D LINE^DGEN("Actions you should take:",.DGLINE)
- D LINE^DGEN("",.DGLINE)
- D LINE^DGEN("- Add Date of Death Information in VistA, or",.DGLINE)
- D LINE^DGEN("",.DGLINE)
- D LINE^DGEN("- Contact the HEC to remove an erroneous Date of Death.",.DGLINE)
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENA3 7829 printed Feb 19, 2025@00:08:22 Page 2
- DGENA3 ;ALB/CJM,ISA,KWP,RTK,TDM,LBD,PHH,PJR,TDM,KUM,JAM - Enrollment API - Consistency check ;03/23/20 12:41pm
- +1 ;;5.3;Registration;**232,306,327,367,417,454,456,491,514,451,808,993,1027,1111**;Aug 13,1993;Build 18
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;CHECKand TESTVAL moved from DGENA1
- CHECK(DGENR,DGPAT,ERRMSG) ;
- +1 ; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED. Comment below modified to reflect this.
- +2 ;Phase II consistency checks do not include INACTIVE(3),DEFERRED(4),SUSPENDED(5),EXPIRED(8),PENDING(9) enrollment statuses. References to these statuses have been removed.
- +3 ;Description: Does validation checks on the enrollment contained in the
- +4 ; DGENR array.
- +5 ;Input:
- +6 ; DGENR - this local array contains an enrollment and should be passed
- +7 ; by reference
- +8 ; DGPAT - this local array contains the patient object, it is optional
- +9 ; If not passed,the database is referenced. (pass by reference)
- +10 ;Output:
- +11 ; Function Value - returns 1 if all validation checks passed, 0
- +12 ; otherwise
- +13 ; ERRMSG - if the consistency checks fail, an error msg is returned (pass by reference)
- +14 NEW VALID,DGELGSUB,SUB,PRIGRP
- +15 SET VALID=0
- +16 SET ERRMSG=""
- +17 ;drops out of block if invalid condition found
- Begin DoDot:1
- +18 IF '$GET(DGENR("DFN"))
- SET ERRMSG="PATIENT NOT FOUND IN DATABASE"
- QUIT
- +19 IF '$DATA(^DPT(DGENR("DFN"),0))
- SET ERRMSG="PATIENT NOT FOUND IN DATABASE"
- QUIT
- +20 ;if it points to a prior record, the DFN must match
- +21 IF DGENR("PRIORREC")
- Begin DoDot:2
- +22 NEW DFN
- +23 SET DFN=$PIECE($GET(^DGEN(27.11,DGENR("PRIORREC"),0)),"^",2)
- +24 IF DFN
- IF DFN'=DGENR("DFN")
- SET ERRMSG="PATIENT'S PRIOR ENROLLMENT BELONGS TO ANOTHER PATIENT"
- End DoDot:2
- if (ERRMSG'="")
- QUIT
- +25 ;check for required fields
- +26 FOR SUB="APP","SOURCE","STATUS","EFFDATE"
- IF $GET(DGENR(SUB))=""
- SET ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS MISSING"
- QUIT
- +27 if (ERRMSG'="")
- QUIT
- +28 ;if the enrollment priority is present, it must be correct
- +29 MERGE DGELGSUB=DGENR("ELIG")
- +30 ;Phase II if the enrollment priority is present it must be correct based on the eligibility factors (SRS 6.5.1.2 d)
- +31 ; ** temporarily commented out for HVE Phase II and III **
- +32 ;I DGENR("PRIORITY") D Q:(ERRMSG'="")
- +33 ;.S PRIGRP=$$PRI^DGENELA4(DGENR("ELIG","CODE"),.DGELGSUB,DGENR("DATE"),$G(DGENR("APP")))
- +34 ;.;check priority
- +35 ;.I DGENR("STATUS")=6 Q ; do not check priority for deceased
- +36 ;.I DGENR("PRIORITY")'=$P(PRIGRP,"^") D Q
- +37 ;..I $G(DGCDIS("VCD"))'="" Q
- +38 ;..S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
- +39 ;.;check subgroup if priority = 7 or 8
- +40 ;.Q:DGENR("PRIORITY")<7
- +41 ;.; sub-priority "e" can be overridden with "a" at HEC
- +42 ;.I "^1^1^5^5^1^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
- +43 ;.; sub-priority "g" can be overridden with "c" at HEC
- +44 ;.I "^3^3^7^7^3^"[("^"_DGENR("SUBGRP")_"^"_$P(PRIGRP,"^",2)_"^") Q
- +45 ;.S ERRMSG="ENROLLMENT PRIORITY IS INCONSISTENT WITH ELIGIBILITY DATA - PRIORITY SHOULD BE "_$P(PRIGRP,"^")_$$EXTERNAL^DILFD(27.11,.12,"F",$P(PRIGRP,"^",2))
- +46 ; end of temporary comments
- +47 ;
- +48 ; DG*5.3*1111 - ENROLLMENT STATUS (file #27.15) entries of REJECTED renamed to DEFERRED.
- +49 ;Phase II require priority if status is VERIFIED(2),DEFERRED-INITIAL APP(14),DEFERRED-FISCAL YEAR(11),DEFERRED-MIDCYCLE(12),DEFERRED-STOP ENROLL(13),DEFERRED-BELOW EGT THRESHOLD(22) (SRS 6.5.1.2 b)
- +50 IF (DGENR("STATUS")=2)!(DGENR("STATUS")=14)!(DGENR("STATUS")=11)!(DGENR("STATUS")=12)!(DGENR("STATUS")=13)!(DGENR("STATUS")=22)
- IF DGENR("PRIORITY")=""
- Begin DoDot:2
- +51 SET ERRMSG="ENROLLMENT PRIORITY IS REQUIRED WITH ENROLLMENT STATUSES: VERIFIED,DEFERRED-INITIAL APPLICATION BY VAMC,DEFERRED-FISCAL YEAR,DEFERRED-MID-CYCLE,DEFERRED-STOP NEW ENROLLMENTS,DEFERRED-BELOW EGT"
- End DoDot:2
- QUIT
- +52 ;Phase II require enrollment date when status is verified(2)(SRS 6.5.1.2 d)
- +53 IF DGENR("STATUS")=2
- IF DGENR("DATE")=""
- SET ERRMSG="ENROLLMENT DATE IS REQUIRED WHEN STATUS IS VERIFIED"
- QUIT
- +54 ;Phase II if enrollment date present with statuses other than verified then veteran must be previously VERIFIED(2) and enrolled (SRS 6.5.1.2 d)
- +55 NEW CURIEN
- SET CURIEN=$$FINDCUR^DGENA(DGENR("DFN"))
- +56 IF DGENR("DATE")
- IF DGENR("DATE")'="@"
- IF DGENR("STATUS")'=2
- IF 'CURIEN
- SET ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED AND THE VETERAN WAS NOT PREVIOUSLY ENROLLED."
- QUIT
- +57 IF DGENR("DATE")
- IF DGENR("DATE")'="@"
- IF DGENR("STATUS")'=2
- IF CURIEN
- IF $PIECE($GET(^DGEN(27.11,CURIEN,0)),"^",4)'=2
- SET ERRMSG="ENROLLMENT DATE IS PRESENT WITH STATUS OTHER THAN VERIFIED WAS PREVIOUSLY ENROLLED BUT THE PREVIOUS STATUS WAS NOT VERIFIED."
- QUIT
- +58 ;if status is not CANCELED/DECLINED, the REASON field should be ""
- +59 IF (DGENR("STATUS")'=7)
- IF DGENR("REASON")
- SET ERRMSG="ENROLLMENT STATUS OF OTHER THAN CANCELED/DECLINED IS INCONSISTENT WITH REASON CANCELED/DECLINED"
- QUIT
- +60 ;if not an eligible vet, enrollment must not have status of VERIFIED, or UNVERIFIED
- +61 ;if status is CANCELED/DECLINED, then reason is required
- +62 IF (DGENR("STATUS")=7)
- IF 'DGENR("REASON")
- SET ERRMSG="STATUS OF CANCELED/DECLINED REQUIRES REASON"
- QUIT
- +63 ;if status is DECEASED and Date of Death is missing, send bulletin
- +64 ; This bulletin has been disabled. DG*5.3*808
- +65 ;I DGENR("STATUS")=6 D
- +66 ;.I $D(DGPAT),'DGPAT("DEATH") D BULLETIN
- +67 ;.I '$D(DGPAT),'$$DEATH^DGENPTA(DGENR("DFN")) D BULLETIN
- +68 if (ERRMSG'="")
- QUIT
- +69 ;certain statuses not allowed for a dead patient
- +70 IF $DATA(DGPAT)
- IF DGPAT("DEATH")
- IF (DGENR("STATUS")=1)!(DGENR("STATUS")=2)
- SET ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT"
- QUIT
- +71 IF '$DATA(DGPAT)
- IF $$DEATH^DGENPTA(DGENR("DFN"))
- IF (DGENR("STATUS")=1)!(DGENR("STATUS")=2)
- SET ERRMSG="ENROLLMENT STATUS OF VERIFIED OR UNVERIFIED NOT ALLOWED FOR A DECEASED PATIENT"
- QUIT
- +72 ;all the field values must be valid
- +73 SET SUB=""
- FOR
- SET SUB=$ORDER(DGENR(SUB))
- if ((ERRMSG'="")!(SUB=""))
- QUIT
- Begin DoDot:2
- +74 ;DG*5.3*1027 - Skip Validity check for Application Date if ES transmits Blank
- +75 IF SUB="APP"
- IF $GET(DGOAPP)=""
- QUIT
- +76 ;
- +77 IF SUB'="ELIG"
- IF (SUB'="DATE")
- IF (SUB'="FACREC")
- IF '$$TESTVAL(SUB,DGENR(SUB))
- SET ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
- End DoDot:2
- +78 if (ERRMSG'="")
- QUIT
- +79 SET SUB=""
- FOR
- SET SUB=$ORDER(DGENR("ELIG",SUB))
- if ((ERRMSG'="")!(SUB=""))
- QUIT
- Begin DoDot:2
- +80 IF '$$TESTVAL(SUB,DGENR("ELIG",SUB))
- SET ERRMSG="ENROLLMENT FIELD "_$$GET1^DID(27.11,$$FIELD^DGENU(SUB),"","LABEL")_" IS NOT VALID"
- End DoDot:2
- +81 ;if this point is reached it's valid
- +82 SET VALID=1
- End DoDot:1
- +83 QUIT VALID
- TESTVAL(SUB,VAL) ;
- +1 ;Description: returns 1 if VAL is a valid value for subscript SUB
- +2 NEW DISPLAY,FIELD,RESULT,VALID
- +3 SET VALID=1
- +4 IF (VAL'="")
- Begin DoDot:1
- +5 SET FIELD=$$FIELD^DGENU(SUB)
- +6 ;if there is no external value then it is not valid
- +7 SET DISPLAY=$$EXTERNAL^DILFD(27.11,FIELD,"F",VAL)
- +8 IF (DISPLAY="")
- SET VALID=0
- QUIT
- +9 IF $$GET1^DID(27.11,FIELD,"","TYPE")'="POINTER"
- Begin DoDot:2
- +10 DO CHK^DIE(27.11,FIELD,,VAL,.RESULT)
- IF RESULT="^"
- SET VALID=0
- QUIT
- End DoDot:2
- End DoDot:1
- +11 QUIT VALID
- BULLETIN ; Status vs. Date of Death Data Discrepancy Bulletin
- +1 ; This bulletin has been disabled. DG*5.3*808
- +2 QUIT
- +3 NEW DGBULL,DGLINE,DGMGRP,DGNAME,DIFROM,VA,VAERR,XMTEXT,XMSUB,XMDUZ
- +4 SET DGMGRP=$ORDER(^XMB(3.8,"B","DGEN ELIGIBILITY ALERT",""))
- +5 if 'DGMGRP
- QUIT
- +6 DO XMY^DGMTUTL(DGMGRP,0,1)
- +7 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
- SET DGSSN=$PIECE($GET(^DPT(DFN,0)),"^",9)
- +8 SET XMTEXT="DGBULL("
- +9 SET XMSUB="STATUS VS. DATE OF DEATH DATA DISCREPANCY"
- +10 SET DGLINE=0
- +11 DO LINE^DGEN("Patient: "_DGNAME,.DGLINE)
- +12 DO LINE^DGEN("SSN: "_DGSSN,.DGLINE)
- +13 DO LINE^DGEN("",.DGLINE)
- +14 DO LINE^DGEN("This Veteran's Enrollment Status is Deceased,",.DGLINE)
- +15 DO LINE^DGEN("however, there is no Date of Death on file for VistA.",.DGLINE)
- +16 DO LINE^DGEN("Actions you should take:",.DGLINE)
- +17 DO LINE^DGEN("",.DGLINE)
- +18 DO LINE^DGEN("- Add Date of Death Information in VistA, or",.DGLINE)
- +19 DO LINE^DGEN("",.DGLINE)
- +20 DO LINE^DGEN("- Contact the HEC to remove an erroneous Date of Death.",.DGLINE)
- +21 DO ^XMD
- +22 QUIT