DGRPC3.m

DGRPC3 ;ALB/PJR,LBD,BAJ,TDM,JDB,JDB,JDB - CHECK CONSISTENCY OF PATIENT DATA (CONT) ;10/20/10 3:40pm

 ;;5.3;Registration;**451,632,673,657,688,754,797,867,903,952,1098,1109,1111**;Aug 13, 1993;Build 18

 ;Per VHA Directive 6402, this routine should not be modified.

 ;

 ; 315 subroutine added by patch DG*5.3*903 which was submitted to OSEHRA 

 ; on 04/02/2015 by HP. This update was authored by James Harris 2014-2015

 ;

79 ;; MSE Dates overlap

 ;; Don't check if MSE Dates Incomplete or if MSE TO precedes FROM

 ;; or unless at least 2 ranges

 S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK I MSDATERR!($L(ANYMSE)<2) D NEXT G @DGLST

 ;Use MSE data in DGPMSE array, if it exists (DG*5.3*797)

 I $D(DGPMSE) D  D NEXT G @DGLST

 .N MS,MSE,OUT S MS=0 F  S MS=$O(DGPMSE(MS)) Q:'MS!($G(OUT))  D

 ..I $P(DGPMSE(MS),U,7) Q  ;Don't check MSE verified by HEC

 ..S MSE=$O(DGPMSE(MS,0)) Q:'MSE

 ..I '$$OVRLPCHK^DGRPDT(DFN,$P(DGPMSE(MS),U),$P(DGPMSE(MS),U,2),1,"","",MSE) S X=79 D COMB S (MSERR,OUT)=1 Q

 ;Otherwise, use MSE data in DGP(.32)

 I ANYMSE[1,'$$OVRLPCHK^DGRPDT(DFN,$P(DGP(.32),"^",6),$P(DGP(.32),"^",7),1,".326^.327") S X=79 D COMB S MSERR=1 D NEXT G @DGLST

 I ANYMSE'[1,'$$OVRLPCHK^DGRPDT(DFN,$P(DGP(.32),"^",11),$P(DGP(.32),"^",12),1,".3292^.3293") S X=79 D COMB S MSERR=1 D NEXT G @DGLST

 D NEXT G @DGLST

80 ;; POW Dates not within MSE

 ;; Check turned off by EVC project (DG*5.3*688)

 D NEXT G @DGLST

81 ;; Combat Dates not within MSE

 I '$P(DGP(.52),"^",12) D NEXT G @DGLST ;; Don't check if no COMBAT Data

 ;; Don't check if COMBAT Data Incomplete or if COMBAT TO precedes FROM

 I ((","_DGER_",")[(",39,"))!((","_DGER_",")[(",40,")) D NEXT G @DGLST

 S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK S:'$G(MSESET) MSESET=$$MSFROMTO^DGMSCK

 ;; If COMBAT, but no MSE, then Range is NOT within MSE

 I 'ANYMSE S X=81 D COMB D NEXT G @DGLST

 I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),$P(DGP(.52),"^",13),$P(DGP(.52),"^",14)) S X=81 D COMB

 D NEXT G @DGLST

82 ;; Conflict Dates not within MSE

 S:'$G(CONCHK) CONCHK=$$CNCK^DGMSCK

 S:'$G(MSECHK) MSECHK=$$MSCK^DGMSCK S:'$G(MSESET) MSESET=$$MSFROMTO^DGMSCK

 S LOC="",I2=0 F I1=1:1 S LOC=$O(CONSPEC(LOC)) Q:LOC=""  I CONARR(LOC)=1 D

 .N FROMDAT,FROMPC,TODAT,TOPC,NODE,DATA

 .S DATA=CONSPEC(LOC)

 .S NODE=$P(DATA,",",1),FROMPC=$P(DATA,",",3),TOPC=$P(DATA,",",4)

 .S FROMDAT=$P(DGP(NODE),"^",FROMPC),TODAT=$P(DGP(NODE),"^",TOPC)

 .I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),FROMDAT,TODAT) S X=82 D COMB:'I2 S CONARR(LOC)=2,I2=1

 .Q

 ; Check OIF/OEF conflict dates

 N DGOEIF D GET^DGENOEIF(DFN,.DGOEIF,0,"",0)

 I $G(DGOEIF("COUNT")),DGER'[",82," D

 . N Z

 . S Z=0 F  S Z=$O(DGOEIF("IEN",Z)) Q:'Z  D  Q:DGER[",82,"

 .. S FROMDAT=$G(DGOEIF("FR",Z)),TODAT=$G(DGOEIF("TO",Z)),LOC=$G(DGOEIF("LOC",Z))

 .. I '$$RWITHIN^DGRPDT($P(MSESET,"^",1),$P(MSESET,"^",2),FROMDAT,TODAT) S X=82 D COMB S I2=1

 D NEXT G @DGLST

83 ;Merchant Seaman or Filipino Vet BOS requires service dates during WWII

 N BOS,BOSN,MS,MSE,OUT

 ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 I $D(DGPMSE) D  D NEXT G @DGLST

 .S MS=0 F  S MS=$O(DGPMSE(MS)) Q:'MS!($G(OUT))  D

 ..I $P(DGPMSE(MS),U,7) Q  ;Don't check MSE if verified by HEC

 ..S BOS=$P(DGPMSE(MS),U,3) Q:'BOS  S BOSN=$P(^DIC(23,BOS,0),U)

 ..S MSE=$O(DGPMSE(MS,0)) Q:'MSE  S MSE="MSE-"_MSE

 ..I $$BRANCH^DGRPMS(BOS_U_BOSN),'$$WWII^DGRPMS(DFN,"",MSE) S X=83 D COMB S OUT=1 Q

 ;Otherwise, get MSE data from DGP(.32)

 F MS=1:1:3 D  Q:$G(OUT)

 .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q

 .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q

 .S BOS=$P(DGP(.32),U,(5*MS)) Q:'BOS  S BOSN=$P($G(^DIC(23,BOS,0)),U)

 .S MSE=$S(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL")

 .I $$BRANCH^DGRPMS(BOS_U_BOSN),'$$WWII^DGRPMS(DFN,"",MSE) S X=83 D COMB S OUT=1 Q

 D NEXT G @DGLST

84 ;Filipino Vet BOS requires Filipino Vet Proof

 N MS,BOS,OUT,MSE

 ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 I $D(DGPMSE) D  D NEXT G @DGLST

 .S MS=0 F  S MS=$O(DGPMSE(MS)) Q:'MS!($G(OUT))  D

 ..I $P(DGPMSE(MS),U,7) Q  ;Don't check MSE if verified by HEC

 ..S BOS=$P(DGPMSE(MS),U,3) Q:'BOS

 ..I $$FV^DGRPMS(BOS)=1,$P(DGP(.321),U,14)="" S X=84 D COMB S OUT=1 Q

 ;Otherwise use MSE data in DGP(.32)

 F MS=1:1:3 D  Q:$G(OUT)

 .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q

 .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q

 .S BOS=$P(DGP(.32),U,(5*MS))

 .I $$FV^DGRPMS(BOS)=1,$P(DGP(.321),U,14)="" S X=84 D COMB S OUT=1 Q

 D NEXT G @DGLST

85 ;Eligible Filipino Vet should have Veteran status = 'YES'

86 ;Ineligible Filipino Vet should have Veteran status = 'NO'

 N MS,BOS,FV,FILV,NOTFV,MSE,OUT

 ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 I $D(DGPMSE) D

 .S MS=0 F  S MS=$O(DGPMSE(MS)) Q:'MS!($G(OUT))  D

 ..I $P(DGPMSE(MS),U,7) Q  ;Don't check MSE if verified by HEC

 ..S BOS=$P(DGPMSE(MS),U,3),FV=$$FV^DGRPMS(BOS) I 'FV S NOTFV="" Q

 ..S MSE=$O(DGPMSE(MS,0)) Q:'MSE  S MSE="MSE-"_MSE

 ..I '$$WWII^DGRPMS(DFN,"",MSE) S FILV("I")="" Q

 ..I FV=2 S FILV("E")="" Q

 ..I $P(DGP(.321),U,14)=""!($P(DGP(.321),U,14)="NO") S FILV("I")="" Q

 ..S FILV("E")=""

 ;Otherwise, get MSE data from DGP(.32)

 E  F MS=1:1:3 D  Q:$G(OUT)

 .I MS=2,$P(DGP(.32),U,19)'="Y" S OUT=1 Q

 .I MS=3,$P(DGP(.32),U,20)'="Y" S OUT=1 Q

 .S BOS=$P(DGP(.32),U,(5*MS)),FV=$$FV^DGRPMS(BOS) I 'FV S NOTFV="" Q

 .S MSE=$S(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL")

 .I '$$WWII^DGRPMS(DFN,"",MSE) S FILV("I")="" Q

 .I FV=2 S FILV("E")="" Q

 .I $P(DGP(.321),U,14)=""!($P(DGP(.321),U,14)="NO") S FILV("I")="" Q

 .S FILV("E")=""

 I $D(FILV) D

 .I DGVT'=1,$D(FILV("E")) S X=85 D COMB Q

 .I DGCHK'[(",86,") Q

 .I DGVT=1,'$D(NOTFV),'$D(FILV("E")),$D(FILV("I")) S X=86 D COMB

 S DGLST=86

 D NEXT G @DGLST

87 ; DG*5.3*657 BAJ 11/24/2005 CC #87 added

 ; SC Eligibility but no rated Disability Codes

 ; 1. Svc Connected is answered "YES"

 ; 2. Eligibility code is either SC < 50% or SC 50-100%

 ; 3. Svc connected %-age is 0 or greater

 ; 4. Patient has no rated disabilities

 ; .. VAEL(1) $P 1 = Primary Eligibility Code  $p 2 = Primary Elig External Value

 ; .. VAEL(3) $P 1 = SERVICE CONNECTED? $P 2 = SC %

 ; .. Rated Disabilities : ^DPT(DFN,.372,0) $P 4 is number of records  '($P($G(^DPT(DFN,.372,0)),"^",4)) is TRUE

 ;

 ; Get Eligibility info

 D ELIG^VADPT

 ;

 ; If not svc connected, don't check

 I '$G(VAEL(3)) D NEXT G @DGLST

 ;

 I +VAEL(3)=1!(+VAEL(3)=3) D

 . Q:$P(VAEL(3),"^",2)<0

 . Q:$P(VAEL(3),"^",2)=""

 . I '($P($G(^DPT(DFN,.372,0)),"^",4)) S X=87 D COMB

 D NEXT G @DGLST

 ;

88 ;Temporary Address check

 N STR88,J,DGI,DGERR,START,END

 S DGERR=0

 I $P(DGP(.121),U,9)="Y" D

 . ;check only if current date is within effective range

 . S START=$P(DGP(.121),U,7),END=$P(DGP(.121),U,8)

 . Q:START=""  I END="" S END=9999999

 . ; quit if current date is not within range

 . I '(DT'<START&(DT'>END)) Q

 . ; country is either NULL or non-numeric

 . I '$P(DGP(.122),U,3) S DGERR=1 Q

 . ; country is not in Country file

 . I '$D(^HL(779.004,$P(DGP(.122),U,3))) S DGERR=1 Q

 . S STR88="1,4,5,6" I $$FORIEN^DGADDUTL($P(DGP(.122),"^",3)) S STR88="1,4"

 . F J=1:1:$L(STR88,",") S DGI=$P(STR88,",",J) Q:DGERR  I $P(DGP(.121),U,DGI)="" S DGERR=1

 I DGERR S X=88 D COMB

 D NEXT G @DGLST

89 ;

 N DGPT,DGELIG

 S DGPT=$$GET1^DIQ(2,DFN_",",391),DGELIG=$$GET1^DIQ(2,DFN+",",.361)

 I DGELIG="EXPANDED MH CARE NON-ENROLLEE",DGPT'="NON-VETERAN (OTHER)" S X=89 D COMB

 D NEXT G @DGLST

99 ; synonymous with END

END I DGNCK S X=99 D COMB

 D OVER99CK

 I DGEDCN S DGCON=0 D TIME^DGRPC

 K C,C1,C2,DGCD,DGD,DGD1,DGD2,DGDATE,DGDEP,DGCHK,DGFL,DGINC,DGISYR,DGLST,DGMS,DGNCK,DGP,DGPMSE,DGPTYP,DGREL,DGSCT,DGT,DGTIME,DGTOT,DGVT,I,I2,I2,J,VAIN,X,X1

 G ^DGRPCF

 ;

COMB S DGCT=DGCT+1,DGER=DGER_X_",",DGLST=X Q

 ;;

NEXT S I=$F(DGCHK,(","_+DGLST_",")),DGLST=+$E(DGCHK,I,999) S:'DGLST DGLST="END"

 Q

 ;

OVER99CK N DGP,DGSD,RULE,FILERR

 D LOADPT^IVMZ07C(DFN,.DGP),LOADSD^IVMZ072(DFN,.DGSD)

 ;DG*5.3*1109 removed 304:GENDER INVALID from following loop

 ;F RULE=301,303,304,306,307,308 S DGLST=RULE_"^IVMZ7CD" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 ;DG*5.3*1111 removed 301:PERSON LASTNAME REQUIRED and 303:GENDER REQUIRED from following loop

 ;F RULE=301,303,306,307,308 S DGLST=RULE_"^IVMZ7CD" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 F RULE=306,307,308 S DGLST=RULE_"^IVMZ7CD" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 ;DG*5.3*1098 removed 406:CLAIM NUMBER INVALID, from following for loop

 F RULE=402,403,407 S DGLST=RULE_"^IVMZ7CE" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 F RULE=501:1:507,516,517 S DGLST=RULE_"^IVMZ7CS" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 F RULE=313 S DGLST=RULE_"^DGRPC3" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 F RULE=314 S DGLST=RULE_"^DGRPC3" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 F RULE=315 S DGLST=RULE_"^DGRPC3" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB

 S DGLST="END"

 Q

 ;

313 ; NEWBORN REQUIRES SPONSOR

 N X

 S DOB=$P(^DPT(DFN,0),"^",3)

 D NOW^%DTC

 S NOW=X

 I $$FMDIFF^XLFDT(NOW,DOB,1)>365 Q  ;NOT A NEWBORN

 I $D(^IBA(355.81,"B",DFN)) Q  ;already has a sponsor

 S FILERR(RULE)=""

 Q

 ; 

314 ;NEWBORN SPONSOR MUST BE ELIGIBLE

 I '$D(^IBA(355.81,"B",DFN)) Q  ;Does not have a sponsor

 N X

 S DOB=$P(^DPT(DFN,0),"^",3)

 D NOW^%DTC

 S NOW=X

 I $$FMDIFF^XLFDT(NOW,DOB,1)>365 Q  ;NOT A NEWBORN

 N RELIEN,SPNIEN,SPNDFN,ELIG

 ;NEED TO FIND SPONSOR IN PATIENT FILE

 S RELIEN="",SPNIEN="",SPNDFN="",ELIG=""

 S RELIEN=$O(^IBA(355.81,"B",DFN,RELIEN))

 S SPNIEN=$$GET1^DIQ(355.81,RELIEN,.02,"I")

 S SPNDFN=$$GET1^DIQ(355.8,SPNIEN,.01,"I")

 S SPNDFN=$P(SPNDFN,";",1)

 S ELIG=$$GET1^DIQ(2,SPNDFN,.3611,"I")

 I ELIG'="" Q  ;sponsor has an eligibility status

 S FILERR(RULE)=""

 Q

 ;

315 ; MHV - subroutine added by patch DG*5.3*903

 Q:'$G(DFN)!'$G(DGPRFLG)

 ;This functionality will not be executed if "Enable MyHealtheVet Prompts?" (#1100.07  

 ;field in MAS PARAMETERS (43) file is not set to YES (internal value 1)

 Q:+$$MHVENABL^DGMHVUTL()'>0

 ;

 N DGFLDCHK,DGMHVACT,DGMHVOUT,DGMHVQ,X,Y,DIR

 Q:$$MHVOK^DGMHVAC(DFN) 

 ; Quit if MHV ENROLLED/Registered has not been answered, and enrollment/registration

 ; action is pending

 S DGMHVACT=$$ENQACHK^DGMHVUTL(DFN) Q:(DGMHVACT]"")&'$G(^DPT(DFN,2))

 S:'$$MHVOK^DGMHVAC(DFN) FILERR(315)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGRPC3   10269     printed  Mar 13, 2025@22:00:39                                                                                                                                                                                                     Page 2

DGRPC3    ;ALB/PJR,LBD,BAJ,TDM,JDB,JDB,JDB - CHECK CONSISTENCY OF PATIENT DATA (CONT) ;10/20/10 3:40pm

 +1       ;;5.3;Registration;**451,632,673,657,688,754,797,867,903,952,1098,1109,1111**;Aug 13, 1993;Build 18

 +2       ;Per VHA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; 315 subroutine added by patch DG*5.3*903 which was submitted to OSEHRA 

 +5       ; on 04/02/2015 by HP. This update was authored by James Harris 2014-2015

 +6       ;

79        ;; MSE Dates overlap

 +1       ;; Don't check if MSE Dates Incomplete or if MSE TO precedes FROM

 +2       ;; or unless at least 2 ranges

 +3        if '$GET(MSECHK)

               SET MSECHK=$$MSCK^DGMSCK

           IF MSDATERR!($LENGTH(ANYMSE)<2)

               DO NEXT

               GOTO @DGLST

 +4       ;Use MSE data in DGPMSE array, if it exists (DG*5.3*797)

 +5        IF $DATA(DGPMSE)

               Begin DoDot:1

 +6                NEW MS,MSE,OUT

                   SET MS=0

                   FOR 

                       SET MS=$ORDER(DGPMSE(MS))

                       if 'MS!($GET(OUT))

                           QUIT 

                       Begin DoDot:2

 +7       ;Don't check MSE verified by HEC

                           IF $PIECE(DGPMSE(MS),U,7)

                               QUIT 

 +8                        SET MSE=$ORDER(DGPMSE(MS,0))

                           if 'MSE

                               QUIT 

 +9                        IF '$$OVRLPCHK^DGRPDT(DFN,$PIECE(DGPMSE(MS),U),$PIECE(DGPMSE(MS),U,2),1,"","",MSE)

                               SET X=79

                               DO COMB

                               SET (MSERR,OUT)=1

                               QUIT 

                       End DoDot:2

               End DoDot:1

               DO NEXT

               GOTO @DGLST

 +10      ;Otherwise, use MSE data in DGP(.32)

 +11       IF ANYMSE[1

               IF '$$OVRLPCHK^DGRPDT(DFN,$PIECE(DGP(.32),"^",6),$PIECE(DGP(.32),"^",7),1,".326^.327")

                   SET X=79

                   DO COMB

                   SET MSERR=1

                   DO NEXT

                   GOTO @DGLST

 +12       IF ANYMSE'[1

               IF '$$OVRLPCHK^DGRPDT(DFN,$PIECE(DGP(.32),"^",11),$PIECE(DGP(.32),"^",12),1,".3292^.3293")

                   SET X=79

                   DO COMB

                   SET MSERR=1

                   DO NEXT

                   GOTO @DGLST

 +13       DO NEXT

           GOTO @DGLST

80        ;; POW Dates not within MSE

 +1       ;; Check turned off by EVC project (DG*5.3*688)

 +2        DO NEXT

           GOTO @DGLST

81        ;; Combat Dates not within MSE

 +1       ;; Don't check if no COMBAT Data

           IF '$PIECE(DGP(.52),"^",12)

               DO NEXT

               GOTO @DGLST

 +2       ;; Don't check if COMBAT Data Incomplete or if COMBAT TO precedes FROM

 +3        IF ((","_DGER_",")[(",39,"))!((","_DGER_",")[(",40,"))

               DO NEXT

               GOTO @DGLST

 +4        if '$GET(MSECHK)

               SET MSECHK=$$MSCK^DGMSCK

           if '$GET(MSESET)

               SET MSESET=$$MSFROMTO^DGMSCK

 +5       ;; If COMBAT, but no MSE, then Range is NOT within MSE

 +6        IF 'ANYMSE

               SET X=81

               DO COMB

               DO NEXT

               GOTO @DGLST

 +7        IF '$$RWITHIN^DGRPDT($PIECE(MSESET,"^",1),$PIECE(MSESET,"^",2),$PIECE(DGP(.52),"^",13),$PIECE(DGP(.52),"^",14))

               SET X=81

               DO COMB

 +8        DO NEXT

           GOTO @DGLST

82        ;; Conflict Dates not within MSE

 +1        if '$GET(CONCHK)

               SET CONCHK=$$CNCK^DGMSCK

 +2        if '$GET(MSECHK)

               SET MSECHK=$$MSCK^DGMSCK

           if '$GET(MSESET)

               SET MSESET=$$MSFROMTO^DGMSCK

 +3        SET LOC=""

           SET I2=0

           FOR I1=1:1

               SET LOC=$ORDER(CONSPEC(LOC))

               if LOC=""

                   QUIT 

               IF CONARR(LOC)=1

                   Begin DoDot:1

 +4                    NEW FROMDAT,FROMPC,TODAT,TOPC,NODE,DATA

 +5                    SET DATA=CONSPEC(LOC)

 +6                    SET NODE=$PIECE(DATA,",",1)

                       SET FROMPC=$PIECE(DATA,",",3)

                       SET TOPC=$PIECE(DATA,",",4)

 +7                    SET FROMDAT=$PIECE(DGP(NODE),"^",FROMPC)

                       SET TODAT=$PIECE(DGP(NODE),"^",TOPC)

 +8                    IF '$$RWITHIN^DGRPDT($PIECE(MSESET,"^",1),$PIECE(MSESET,"^",2),FROMDAT,TODAT)

                           SET X=82

                           if 'I2

                               DO COMB

                           SET CONARR(LOC)=2

                           SET I2=1

 +9                    QUIT 

                   End DoDot:1

 +10      ; Check OIF/OEF conflict dates

 +11       NEW DGOEIF

           DO GET^DGENOEIF(DFN,.DGOEIF,0,"",0)

 +12       IF $GET(DGOEIF("COUNT"))

               IF DGER'[",82,"

                   Begin DoDot:1

 +13                   NEW Z

 +14                   SET Z=0

                       FOR 

                           SET Z=$ORDER(DGOEIF("IEN",Z))

                           if 'Z

                               QUIT 

                           Begin DoDot:2

 +15                           SET FROMDAT=$GET(DGOEIF("FR",Z))

                               SET TODAT=$GET(DGOEIF("TO",Z))

                               SET LOC=$GET(DGOEIF("LOC",Z))

 +16                           IF '$$RWITHIN^DGRPDT($PIECE(MSESET,"^",1),$PIECE(MSESET,"^",2),FROMDAT,TODAT)

                                   SET X=82

                                   DO COMB

                                   SET I2=1

                           End DoDot:2

                           if DGER[",82,"

                               QUIT 

                   End DoDot:1

 +17       DO NEXT

           GOTO @DGLST

83        ;Merchant Seaman or Filipino Vet BOS requires service dates during WWII

 +1        NEW BOS,BOSN,MS,MSE,OUT

 +2       ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 +3        IF $DATA(DGPMSE)

               Begin DoDot:1

 +4                SET MS=0

                   FOR 

                       SET MS=$ORDER(DGPMSE(MS))

                       if 'MS!($GET(OUT))

                           QUIT 

                       Begin DoDot:2

 +5       ;Don't check MSE if verified by HEC

                           IF $PIECE(DGPMSE(MS),U,7)

                               QUIT 

 +6                        SET BOS=$PIECE(DGPMSE(MS),U,3)

                           if 'BOS

                               QUIT 

                           SET BOSN=$PIECE(^DIC(23,BOS,0),U)

 +7                        SET MSE=$ORDER(DGPMSE(MS,0))

                           if 'MSE

                               QUIT 

                           SET MSE="MSE-"_MSE

 +8                        IF $$BRANCH^DGRPMS(BOS_U_BOSN)

                               IF '$$WWII^DGRPMS(DFN,"",MSE)

                                   SET X=83

                                   DO COMB

                                   SET OUT=1

                                   QUIT 

                       End DoDot:2

               End DoDot:1

               DO NEXT

               GOTO @DGLST

 +9       ;Otherwise, get MSE data from DGP(.32)

 +10       FOR MS=1:1:3

               Begin DoDot:1

 +11               IF MS=2

                       IF $PIECE(DGP(.32),U,19)'="Y"

                           SET OUT=1

                           QUIT 

 +12               IF MS=3

                       IF $PIECE(DGP(.32),U,20)'="Y"

                           SET OUT=1

                           QUIT 

 +13               SET BOS=$PIECE(DGP(.32),U,(5*MS))

                   if 'BOS

                       QUIT 

                   SET BOSN=$PIECE($GET(^DIC(23,BOS,0)),U)

 +14               SET MSE=$SELECT(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL")

 +15               IF $$BRANCH^DGRPMS(BOS_U_BOSN)

                       IF '$$WWII^DGRPMS(DFN,"",MSE)

                           SET X=83

                           DO COMB

                           SET OUT=1

                           QUIT 

               End DoDot:1

               if $GET(OUT)

                   QUIT 

 +16       DO NEXT

           GOTO @DGLST

84        ;Filipino Vet BOS requires Filipino Vet Proof

 +1        NEW MS,BOS,OUT,MSE

 +2       ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 +3        IF $DATA(DGPMSE)

               Begin DoDot:1

 +4                SET MS=0

                   FOR 

                       SET MS=$ORDER(DGPMSE(MS))

                       if 'MS!($GET(OUT))

                           QUIT 

                       Begin DoDot:2

 +5       ;Don't check MSE if verified by HEC

                           IF $PIECE(DGPMSE(MS),U,7)

                               QUIT 

 +6                        SET BOS=$PIECE(DGPMSE(MS),U,3)

                           if 'BOS

                               QUIT 

 +7                        IF $$FV^DGRPMS(BOS)=1

                               IF $PIECE(DGP(.321),U,14)=""

                                   SET X=84

                                   DO COMB

                                   SET OUT=1

                                   QUIT 

                       End DoDot:2

               End DoDot:1

               DO NEXT

               GOTO @DGLST

 +8       ;Otherwise use MSE data in DGP(.32)

 +9        FOR MS=1:1:3

               Begin DoDot:1

 +10               IF MS=2

                       IF $PIECE(DGP(.32),U,19)'="Y"

                           SET OUT=1

                           QUIT 

 +11               IF MS=3

                       IF $PIECE(DGP(.32),U,20)'="Y"

                           SET OUT=1

                           QUIT 

 +12               SET BOS=$PIECE(DGP(.32),U,(5*MS))

 +13               IF $$FV^DGRPMS(BOS)=1

                       IF $PIECE(DGP(.321),U,14)=""

                           SET X=84

                           DO COMB

                           SET OUT=1

                           QUIT 

               End DoDot:1

               if $GET(OUT)

                   QUIT 

 +14       DO NEXT

           GOTO @DGLST

85        ;Eligible Filipino Vet should have Veteran status = 'YES'

86        ;Ineligible Filipino Vet should have Veteran status = 'NO'

 +1        NEW MS,BOS,FV,FILV,NOTFV,MSE,OUT

 +2       ;Use MSE data from DGPMSE array, if it exists (DG*5.3*797)

 +3        IF $DATA(DGPMSE)

               Begin DoDot:1

 +4                SET MS=0

                   FOR 

                       SET MS=$ORDER(DGPMSE(MS))

                       if 'MS!($GET(OUT))

                           QUIT 

                       Begin DoDot:2

 +5       ;Don't check MSE if verified by HEC

                           IF $PIECE(DGPMSE(MS),U,7)

                               QUIT 

 +6                        SET BOS=$PIECE(DGPMSE(MS),U,3)

                           SET FV=$$FV^DGRPMS(BOS)

                           IF 'FV

                               SET NOTFV=""

                               QUIT 

 +7                        SET MSE=$ORDER(DGPMSE(MS,0))

                           if 'MSE

                               QUIT 

                           SET MSE="MSE-"_MSE

 +8                        IF '$$WWII^DGRPMS(DFN,"",MSE)

                               SET FILV("I")=""

                               QUIT 

 +9                        IF FV=2

                               SET FILV("E")=""

                               QUIT 

 +10                       IF $PIECE(DGP(.321),U,14)=""!($PIECE(DGP(.321),U,14)="NO")

                               SET FILV("I")=""

                               QUIT 

 +11                       SET FILV("E")=""

                       End DoDot:2

               End DoDot:1

 +12      ;Otherwise, get MSE data from DGP(.32)

 +13      IF '$TEST

               FOR MS=1:1:3

                   Begin DoDot:1

 +14                   IF MS=2

                           IF $PIECE(DGP(.32),U,19)'="Y"

                               SET OUT=1

                               QUIT 

 +15                   IF MS=3

                           IF $PIECE(DGP(.32),U,20)'="Y"

                               SET OUT=1

                               QUIT 

 +16                   SET BOS=$PIECE(DGP(.32),U,(5*MS))

                       SET FV=$$FV^DGRPMS(BOS)

                       IF 'FV

                           SET NOTFV=""

                           QUIT 

 +17                   SET MSE=$SELECT(MS=1:"MSL",MS=2:"MSNTL",1:"MSNNTL")

 +18                   IF '$$WWII^DGRPMS(DFN,"",MSE)

                           SET FILV("I")=""

                           QUIT 

 +19                   IF FV=2

                           SET FILV("E")=""

                           QUIT 

 +20                   IF $PIECE(DGP(.321),U,14)=""!($PIECE(DGP(.321),U,14)="NO")

                           SET FILV("I")=""

                           QUIT 

 +21                   SET FILV("E")=""

                   End DoDot:1

                   if $GET(OUT)

                       QUIT 

 +22       IF $DATA(FILV)

               Begin DoDot:1

 +23               IF DGVT'=1

                       IF $DATA(FILV("E"))

                           SET X=85

                           DO COMB

                           QUIT 

 +24               IF DGCHK'[(",86,")

                       QUIT 

 +25               IF DGVT=1

                       IF '$DATA(NOTFV)

                           IF '$DATA(FILV("E"))

                               IF $DATA(FILV("I"))

                                   SET X=86

                                   DO COMB

               End DoDot:1

 +26       SET DGLST=86

 +27       DO NEXT

           GOTO @DGLST

87        ; DG*5.3*657 BAJ 11/24/2005 CC #87 added

 +1       ; SC Eligibility but no rated Disability Codes

 +2       ; 1. Svc Connected is answered "YES"

 +3       ; 2. Eligibility code is either SC < 50% or SC 50-100%

 +4       ; 3. Svc connected %-age is 0 or greater

 +5       ; 4. Patient has no rated disabilities

 +6       ; .. VAEL(1) $P 1 = Primary Eligibility Code  $p 2 = Primary Elig External Value

 +7       ; .. VAEL(3) $P 1 = SERVICE CONNECTED? $P 2 = SC %

 +8       ; .. Rated Disabilities : ^DPT(DFN,.372,0) $P 4 is number of records  '($P($G(^DPT(DFN,.372,0)),"^",4)) is TRUE

 +9       ;

 +10      ; Get Eligibility info

 +11       DO ELIG^VADPT

 +12      ;

 +13      ; If not svc connected, don't check

 +14       IF '$GET(VAEL(3))

               DO NEXT

               GOTO @DGLST

 +15      ;

 +16       IF +VAEL(3)=1!(+VAEL(3)=3)

               Begin DoDot:1

 +17               if $PIECE(VAEL(3),"^",2)<0

                       QUIT 

 +18               if $PIECE(VAEL(3),"^",2)=""

                       QUIT 

 +19               IF '($PIECE($GET(^DPT(DFN,.372,0)),"^",4))

                       SET X=87

                       DO COMB

               End DoDot:1

 +20       DO NEXT

           GOTO @DGLST

 +21      ;

88        ;Temporary Address check

 +1        NEW STR88,J,DGI,DGERR,START,END

 +2        SET DGERR=0

 +3        IF $PIECE(DGP(.121),U,9)="Y"

               Begin DoDot:1

 +4       ;check only if current date is within effective range

 +5                SET START=$PIECE(DGP(.121),U,7)

                   SET END=$PIECE(DGP(.121),U,8)

 +6                if START=""

                       QUIT 

                   IF END=""

                       SET END=9999999

 +7       ; quit if current date is not within range

 +8                IF '(DT'<START&(DT'>END))

                       QUIT 

 +9       ; country is either NULL or non-numeric

 +10               IF '$PIECE(DGP(.122),U,3)

                       SET DGERR=1

                       QUIT 

 +11      ; country is not in Country file

 +12               IF '$DATA(^HL(779.004,$PIECE(DGP(.122),U,3)))

                       SET DGERR=1

                       QUIT 

 +13               SET STR88="1,4,5,6"

                   IF $$FORIEN^DGADDUTL($PIECE(DGP(.122),"^",3))

                       SET STR88="1,4"

 +14               FOR J=1:1:$LENGTH(STR88,",")

                       SET DGI=$PIECE(STR88,",",J)

                       if DGERR

                           QUIT 

                       IF $PIECE(DGP(.121),U,DGI)=""

                           SET DGERR=1

               End DoDot:1

 +15       IF DGERR

               SET X=88

               DO COMB

 +16       DO NEXT

           GOTO @DGLST

89        ;

 +1        NEW DGPT,DGELIG

 +2        SET DGPT=$$GET1^DIQ(2,DFN_",",391)

           SET DGELIG=$$GET1^DIQ(2,DFN+",",.361)

 +3        IF DGELIG="EXPANDED MH CARE NON-ENROLLEE"