DGRPC3 ;ALB/PJR,LBD,BAJ,TDM - CHECK CONSISTENCY OF PATIENT DATA (CONT) ; 10/20/10 3:40pm
;;5.3;PIMS;**451,632,673,657,1015,1016**;JUN 30, 2012;Build 20
;
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
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)
F RULE=301,303,304,306:1:308 S DGLST=RULE_"^IVMZ7CD" D @DGLST I $D(FILERR(RULE)) S X=RULE D COMB
F RULE=402,403,406,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
S DGLST="END"
Q
DGRPC3 ;ALB/PJR,LBD,BAJ,TDM - CHECK CONSISTENCY OF PATIENT DATA (CONT) ; 10/20/10 3:40pm
+1 ;;5.3;PIMS;**451,632,673,657,1015,1016**;JUN 30, 2012;Build 20
+2 ;
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
99 ; synonymous with END
END IF DGNCK
SET X=99
DO COMB
+1 DO OVER99CK
+2 IF DGEDCN
SET DGCON=0
DO TIME^DGRPC
+3 KILL 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
+4 GOTO ^DGRPCF
+5 ;
COMB SET DGCT=DGCT+1
SET DGER=DGER_X_","
SET DGLST=X
QUIT
+1 ;;
NEXT SET I=$FIND(DGCHK,(","_+DGLST_","))
SET DGLST=+$EXTRACT(DGCHK,I,999)
IF 'DGLST
SET DGLST="END"
+1 QUIT
+2 ;
OVER99CK NEW DGP,DGSD,RULE,FILERR
+1 DO LOADPT^IVMZ07C(DFN,.DGP)
DO LOADSD^IVMZ072(DFN,.DGSD)
+2 FOR RULE=301,303,304,306:1:308
SET DGLST=RULE_"^IVMZ7CD"
DO @DGLST
IF $DATA(FILERR(RULE))
SET X=RULE
DO COMB
+3 FOR RULE=402,403,406,407
SET DGLST=RULE_"^IVMZ7CE"
DO @DGLST
IF $DATA(FILERR(RULE))
SET X=RULE
DO COMB
+4 FOR RULE=501:1:507,516,517
SET DGLST=RULE_"^IVMZ7CS"
DO @DGLST
IF $DATA(FILERR(RULE))
SET X=RULE
DO COMB
+5 SET DGLST="END"
+6 QUIT
