DGRPCE1.m

DGRPCE1 ;ALB/MIR/BRM/LBD,BAJ,TDM - CONSISTENCY CHECKER EDIT ; 10/20/10 4:16pm

 ;;5.3;PIMS;**108,226,470,454,489,505,522,451,632,689,657,1015,1016**;JUN 30, 2012;Build 20

 N DGMSERR S DGMSERR="" I $$NEWMSE(DFN) S DGMSERR=",67,72,73,79,81,83,"

 N I,J F I=1:1:8,16,53,57,58,61:1:88 D SASK

 F I=301,303,304,306:1:308,402,403,406,407,501:1:507,516,517 D SASK

 ;F I=49,50,52 D SASK ;BELOW REPLACED WITH ^IBCNSP2 CALL

 ;OLDS DR(2,2.312)="S DGRPADI="""";.01;1;2;15;8;7;3;6;S DGRPADI=X;I DGRPADI'=""v"" S Y=""@2312"";17///^S X=""`""_DFN;16///^S X=""01"";S Y=""@23121"";@2312;17;16//^S X=$S(DGRPADI=""s"":""02"",1:"""");@23121;9:14;"

 Q

SASK I DGER[(","_I_","),DGASK'[(","_I_","),DGMSERR'[(","_I_",") F J=I,I*1000:1 Q:'$T(@J)  S DGD=DGD_$P($T(@J),";;",2,999) D SAVE

 S DGASK=DGASK_I_","

 Q

SAVE I $L(@DGDR)+$L(DGD)<241 S @DGDR=@DGDR_DGD,DGD="" Q

 S DGDRC=DGDRC+1,DGDR="DR(1,2,"_DGDRC_")",@DGDR=DGD,DGD="" Q

 ;

 ;

ELIG ;eligibility code...if M11+, use compiled template, otherwise DR string

 I ^%ZOSF("OS")'["M/11+" S DGD=$P($T(14),";;",2,999) D SAVE Q

 N DA,DIE,DR S DIE="^DPT(",DA=DFN,DR="[DG CONSISTENCY CHECKER]" D ^DIE

 Q

 ;

 ;

1 ;;.01;

2 ;;1;

3 ;;.02;

4 ;;.03;

5 ;;.05;

6 ;;.08;

7 ;;.09;

8 ;;N FLG S FLG(2)=1 S:$G(DGER)[",61," FLG(1)=1 D EN^DGREGAED(DFN,.FLG);

14 ;;.361;S DGECODE=$S($D(^DIC(8,+X,0)):$P(^(0),"^",1),1:"");S:$S(DGECODE["ALLIED":0,DGECODE["FEDERAL":0,1:1) Y=.323;.309;.323;D ^DGYZODS;S:'DGODS Y="@14";11500.02;11500.03;@14;

16 ;;.351;

53 ;;.07;.31115;I $S(X']"":1,X=3:1,X=9:1,1:0) S Y="@53";.3111;S:X']"" Y="@53";.3113;S:X']"" Y=.3116;.3114;S:X']"" Y=.3116;.3115:.3117;.2205;.3119;@53;

57 ;;.381;.382///NOW;

58 ;;.322013;S:X'="Y" Y="@589";.322014;.322015;.32201;S:X'="Y" Y="@581";.322011;.322012;@581;.322016;S:X'="Y" Y="@589";.322017;.322018;@589;

61 ;;S:$G(DGER)[",8," Y="@619";.132;@619;

62 ;;.331;

63 ;;D EN^DGREGTED(DFN,"CONF");

64 ;;.092;.093;

65 ;;.2403;

66 ;;.09;

67 ;;S:$$DGERCK^DGRPCE1("73^79^80^81^82",.DGER) Y="@67";W !!,$C(7),"SERVICE SEPARATION DATE [LAST] must be a precise date to determine CV Elig",!;.325;.32911;.326;.327;@67;

68 ;;S:$$DGERCK^DGRPCE1("39^40",.DGER) Y="@68";W !!,$C(7),"COMBAT TO DATE must be a precise date to determine CV Eligibility",!;.5291;S:X'="Y" Y="@68";.5292;.5293;.5294;@68;

69 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@69";W !!,$C(7),"YUGOSLAVIA TO DATE must be a precise date to determine CV Eligibility",!;.322019;S:X'="Y" Y="@69";.32202;.322021;@69;

70 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@70";W !!,$C(7),"SOMALIA TO DATE must be a precise date to determine CV Eligibility",!;.322016;S:X'="Y" Y="@70";.322017;.322018,@70;

71 ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@71";W !!,$C(7),"PERSIAN GULF TO DATE must be a precise date to determine CV Eligibility",!;.32201;S:X'="Y" Y="@71";.322011;.322012;@71;

72 ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7201";.3291;.32912;.3292;.3293;.329;@7201;S:'$$YN^DGRPCE1(.32945) Y="@7202";.3296;.32913;.3297;.3298;.3295;@7202;

 ;

73 ;;S:$$DGERCK^DGRPCE1(72,.DGER) Y="@7302";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7301";.3291;.32912;.3292;.3293;.329;@7301;S:'$$YN^DGRPCE1(.32945) Y="@7302";.3296;.32913;.3297;.3298;.3295;@7302;

74 ;;S:'$$YN^DGRPCE1(.32101) Y="@7401";.32101;S:X'="Y" Y="@7401";.32104;.32105;@7401;S:'$$YN^DGRPCE1(.322016) Y="@7402";.322016;S:X'="Y" Y="@7402";.322017;.322018;@7402;

74000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7403";.322019;S:X'="Y" Y="@7403";.32202;.322021;@7403;S:'$$YN^DGRPCE1(.3221) Y="@7404";.3221;S:X'="Y" Y="@7404";.3222;.3223;@7404;

74001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7405";.3224;S:X'="Y" Y="@7405";.3225;.3226;@7405;S:'$$YN^DGRPCE1(.3227) Y="@7406";.3227;S:X'="Y" Y="@7406";.3228;.3229;@7406;

74002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7407";.32201;S:X'="Y" Y="@7407";.322011;.322012;@7407;

75 ;;S:$$DGERCK^DGRPCE1(74,.DGER) Y="@7507";S:'$$YN^DGRPCE1(.32101) Y="@7501";.32101;S:X'="Y" Y="@7501";.32104;.32105;@7501;S:'$$YN^DGRPCE1(.322016) Y="@7502";.322016;S:X'="Y" Y="@7502";.322017;.322018;@7502;

75000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7503";.322019;S:X'="Y" Y="@7503";.32202;.322021;@7503;S:'$$YN^DGRPCE1(.3221) Y="@7504";.3221;S:X'="Y" Y="@7504";.3222;.3223;@7504;

75001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7505";.3224;S:X'="Y" Y="@7505";.3225;.3226;@7505;S:'$$YN^DGRPCE1(.3227) Y="@7506";.3227;S:X'="Y" Y="@7506";.3228;.3229;@7506;

75002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7507";.32201;S:X'="Y" Y="@7507";.322011;.322012;@7507;

76 ;;S:$$DGERCK^DGRPCE1("74^75",.DGER) Y="@7607";S:'$$YN^DGRPCE1(.32101) Y="@7601";.32101;S:X'="Y" Y="@7601";.32104;.32105;@7601;S:'$$YN^DGRPCE1(.322016) Y="@7602";.322016;S:X'="Y" Y="@7602";.322017;.322018;@7602;

76000 ;;S:'$$YN^DGRPCE1(.322019) Y="@7603";.322019;S:X'="Y" Y="@7603";.32202;.322021;@7603;S:'$$YN^DGRPCE1(.3221) Y="@7604";.3221;S:X'="Y" Y="@7604";.3222;.3223;@7604;

76001 ;;S:'$$YN^DGRPCE1(.3224) Y="@7605";.3224;S:X'="Y" Y="@7605";.3225;.3226;@7605;S:'$$YN^DGRPCE1(.3227) Y="@7606";.3227;S:X'="Y" Y="@7606";.3228;.3229;@7606;

76002 ;;S:'$$YN^DGRPCE1(.32201) Y="@7607";.32201;S:X'="Y" Y="@7607";.322011;.322012;@7607;

77 ;;S:(($$DGERCK^DGRPCE1("37^38",.DGER))!('$$YN^DGRPCE1(.525))) Y="@77";.525;S:X'="Y" Y="@77";.526;.527;.528;@77;

78 ;;S:(($$DGERCK^DGRPCE1("39^40^68",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@78";.5291;S:X'="Y" Y="@78";.5292;.5293;.5294;@78;

79 ;;S:$$DGERCK^DGRPCE1("72^73",.DGER) Y="@7902";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7901";.3291;.32912;.3292;.3293;.329;@7901;S:'$$YN^DGRPCE1(.32945) Y="@7902";.3296;.32913;.3297;.3298;.3295;@7902;

80 ;;S:(($$DGERCK^DGRPCE1("37^38^77",.DGER))!('$$YN^DGRPCE1(.525))) Y="@8001";.525;S:X'="Y" Y="@8001";.526;.527;.528;@8001;S:$$DGERCK^DGRPCE1("72^73^79",.DGER) Y="@8003";

80000 ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8002";.3291;.32912;.3292;.3293;.329;@8002;S:'$$YN^DGRPCE1(.32945) Y="@8003";.3296;.32913;.3297;.3298;.3295;@8003;

81 ;;S:(($$DGERCK^DGRPCE1("39^40^78",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@8101";.5291;S:X'="Y" Y="@8101";.5292;.5293;.5294;@8101;S:$$DGERCK^DGRPCE1("72^73^79^80",.DGER) Y="@8103";

81000 ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8102";.3291;.32912;.3292;.3293;.329;@8102;S:'$$YN^DGRPCE1(.32945) Y="@8103";.3296;.32913;.3297;.3298;.3295;@8103;

82 ;;S:($$DGERCK^DGRPCE1("74^75^76",.DGER)) Y="@8207";S:'$$YN^DGRPCE1(.32101) Y="@8201";.32101;S:X'="Y" Y="@8201";.32104;.32105;@8201;S:'$$YN^DGRPCE1(.322016) Y="@8202";.322016;

82000 ;;S:X'="Y" Y="@8202";.322017;.322018;@8202;S:'$$YN^DGRPCE1(.322019) Y="@8203";.322019;S:X'="Y" Y="@8203";.32202;.322021;@8203;S:'$$YN^DGRPCE1(.3221) Y="@8204";.3221;

82001 ;;S:X'="Y" Y="@8204";.3222;.3223;@8204;S:'$$YN^DGRPCE1(.3224) Y="@8205";.3224;S:X'="Y" Y="@8205";.3225;.3226;@8205;S:'$$YN^DGRPCE1(.3227) Y="@8206";.3227;S:X'="Y" Y="@8206";

82002 ;;.3228;.3229;@8206;S:'$$YN^DGRPCE1(.32201) Y="@8207";.32201;S:X'="Y" Y="@8207";.322011;.322012;@8207;S:($$DGERCK^DGRPCE1("72^73^79^80^81",.DGER)) Y="@8209";

82003 ;;S:$$NEWMSE^DGRPCE1(DFN) Y="@8209";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8208";.3291;.32912;.3292;.3293;.329;@8208;S:'$$YN^DGRPCE1(.32945) Y="@8209";.3296;.32913;.3297;.3298;.3295;@8209;

83 ;;S:$$DGERCK^DGRPCE1(73,.DGER) Y="@83";@8295;D SET32^DGRPE(DA,.DIPA,1);.325;S DIPA("X1")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@8296";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y="@8295";

83000 ;;@8296;D:DIPA("X1")'="" WARN32^DGRPE(DIPA("X1"),.DIPA,1,.Y) S:$E(Y,1,4)="@601" Y=.326;.32911;.326;.327;

83001 ;;.3285//NO;S:X'="Y" Y="@83";D SET32^DGRPE(DA,.DIPA,2);.3291;S DIPA("X2")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@832";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3291";S Y=.3292;

83002 ;;@832;D:DIPA("X2")'="" WARN32^DGRPE(DIPA("X2"),.DIPA,2,.Y) S:$E(Y,1,4)="@601" Y=.3292;.32912;.3292;.3293;

83003 ;;.32945//NO;S:X'="Y" Y="@83";D SET32^DGRPE(DA,.DIPA,3);.3296;S DIPA("X3")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@833";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3296";S Y=.3297;@833;

83004 ;;D:DIPA("X3")'="" WARN32^DGRPE(DIPA("X3"),.DIPA,3,.Y) S:$E(Y,1,4)="@601" Y=.3297;.32913;.3297;.3298;@83;

84 ;;.3214;

85 ;;1901;

86 ;;1901;

87 ;;D VETTYPE^DGRPE1;D MSG^DGRPE1 S Y=0;@114;K DGRDCHG;D DR^DGRPE1;.302;.3721;D EFF^DGRPE1;D:$G(DGRDCHG) BULL^DGRPE1;K DGRDCHG;

88 ;;D EN^DGREGTED(DFN,"TEMP");

301 ;;.01;

303 ;;.02;

304 ;;.02;

306 ;;.09;

307 ;;.0906;

308 ;;.351;

402 ;;.381;

403 ;;.382;

406 ;;.313;

407 ;;.3611;

501 ;;.525;

502 ;;.3602;

503 ;;.3603;

504 ;;.32102;

505 ;;.32103;

506 ;;.322013;

507 ;;.32103;.3212;

516 ;;.03;

517 ;;.03;

 ;

YN(FLD,DFN,FILE) ; return binary for YES/NO flds in the Patient (#2) file

 N RTN

 Q:$G(FLD)']"" ""

 S:$G(FILE)="" FILE=2 S:$G(DFN)="" DFN=$G(DA) Q:$G(DFN)']"" ""

 S RTN=$$GET1^DIQ(FILE,DFN_",",FLD,"I")

 Q $S(RTN=1:1,RTN=0:0,RTN="Y":1,RTN="N":0,1:"")

 ;

DGERCK(STR,DGER) ;do any of the STR errors exist in DGER?

 N RTN,X

 Q:$G(STR)']"" 0  Q:$G(DGER)']"" 0

 S RTN=0 F X=1:1 Q:RTN!($P(STR,"^",X)="")  I DGER[(","_$P(STR,"^",X)_",") S RTN=1

 Q RTN

 ;

NEWMSE(DFN) ;Is there data in the new MSE sub-file #2.3216?

 I $G(DFN)="" S DFN=$G(DA)

 Q:$G(DFN)="" 0

 I $O(^DPT(DFN,.3216,0)) Q 1

 Q 0

 ;

MSERR() ;Are there MSE data inconsistencies?

 N ERR,RTN

 S RTN=0

 F ERR=67,72,73,79,81,82,83 I DGER[ERR S RTN=1

 Q RTN

DGRPCE1   ;ALB/MIR/BRM/LBD,BAJ,TDM - CONSISTENCY CHECKER EDIT ; 10/20/10 4:16pm

 +1       ;;5.3;PIMS;**108,226,470,454,489,505,522,451,632,689,657,1015,1016**;JUN 30, 2012;Build 20

 +2        NEW DGMSERR

           SET DGMSERR=""

           IF $$NEWMSE(DFN)

               SET DGMSERR=",67,72,73,79,81,83,"

 +3        NEW I,J

           FOR I=1:1:8,16,53,57,58,61:1:88

               DO SASK

 +4        FOR I=301,303,304,306:1:308,402,403,406,407,501:1:507,516,517

               DO SASK

 +5       ;F I=49,50,52 D SASK ;BELOW REPLACED WITH ^IBCNSP2 CALL

 +6       ;OLDS DR(2,2.312)="S DGRPADI="""";.01;1;2;15;8;7;3;6;S DGRPADI=X;I DGRPADI'=""v"" S Y=""@2312"";17///^S X=""`""_DFN;16///^S X=""01"";S Y=""@23121"";@2312;17;16//^S X=$S(DGRPADI=""s"":""02"",1:"""");@23121;9:14;"

 +7        QUIT 

SASK       IF DGER[(","_I_",")

               IF DGASK'[(","_I_",")

                   IF DGMSERR'[(","_I_",")

                       FOR J=I,I*1000:1

                           IF '$TEXT(@J)

                               QUIT 

                           SET DGD=DGD_$PIECE($TEXT(@J),";;",2,999)

                           DO SAVE

 +1        SET DGASK=DGASK_I_","

 +2        QUIT 

SAVE       IF $LENGTH(@DGDR)+$LENGTH(DGD)<241

               SET @DGDR=@DGDR_DGD

               SET DGD=""

               QUIT 

 +1        SET DGDRC=DGDRC+1

           SET DGDR="DR(1,2,"_DGDRC_")"

           SET @DGDR=DGD

           SET DGD=""

           QUIT 

 +2       ;

 +3       ;

ELIG      ;eligibility code...if M11+, use compiled template, otherwise DR string

 +1        IF ^%ZOSF("OS")'["M/11+"

               SET DGD=$PIECE($TEXT(14),";;",2,999)

               DO SAVE

               QUIT 

 +2        NEW DA,DIE,DR

           SET DIE="^DPT("

           SET DA=DFN

           SET DR="[DG CONSISTENCY CHECKER]"

           DO ^DIE

 +3        QUIT 

 +4       ;

 +5       ;

1         ;;.01;

2         ;;1;

3         ;;.02;

4         ;;.03;

5         ;;.05;

6         ;;.08;

7         ;;.09;

8         ;;N FLG S FLG(2)=1 S:$G(DGER)[",61," FLG(1)=1 D EN^DGREGAED(DFN,.FLG);

14        ;;.361;S DGECODE=$S($D(^DIC(8,+X,0)):$P(^(0),"^",1),1:"");S:$S(DGECODE["ALLIED":0,DGECODE["FEDERAL":0,1:1) Y=.323;.309;.323;D ^DGYZODS;S:'DGODS Y="@14";11500.02;11500.03;@14;

16        ;;.351;

53        ;;.07;.31115;I $S(X']"":1,X=3:1,X=9:1,1:0) S Y="@53";.3111;S:X']"" Y="@53";.3113;S:X']"" Y=.3116;.3114;S:X']"" Y=.3116;.3115:.3117;.2205;.3119;@53;

57        ;;.381;.382///NOW;

58        ;;.322013;S:X'="Y" Y="@589";.322014;.322015;.32201;S:X'="Y" Y="@581";.322011;.322012;@581;.322016;S:X'="Y" Y="@589";.322017;.322018;@589;

61        ;;S:$G(DGER)[",8," Y="@619";.132;@619;

62        ;;.331;

63        ;;D EN^DGREGTED(DFN,"CONF");

64        ;;.092;.093;

65        ;;.2403;

66        ;;.09;

67        ;;S:$$DGERCK^DGRPCE1("73^79^80^81^82",.DGER) Y="@67";W !!,$C(7),"SERVICE SEPARATION DATE [LAST] must be a precise date to determine CV Elig",!;.325;.32911;.326;.327;@67;

68        ;;S:$$DGERCK^DGRPCE1("39^40",.DGER) Y="@68";W !!,$C(7),"COMBAT TO DATE must be a precise date to determine CV Eligibility",!;.5291;S:X'="Y" Y="@68";.5292;.5293;.5294;@68;

69        ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@69";W !!,$C(7),"YUGOSLAVIA TO DATE must be a precise date to determine CV Eligibility",!;.322019;S:X'="Y" Y="@69";.32202;.322021;@69;

70        ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@70";W !!,$C(7),"SOMALIA TO DATE must be a precise date to determine CV Eligibility",!;.322016;S:X'="Y" Y="@70";.322017;.322018,@70;

71        ;;S:$$DGERCK^DGRPCE1("74^75^76",.DGER) Y="@71";W !!,$C(7),"PERSIAN GULF TO DATE must be a precise date to determine CV Eligibility",!;.32201;S:X'="Y" Y="@71";.322011;.322012;@71;

72        ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7201";.3291;.32912;.3292;.3293;.329;@7201;S:'$$YN^DGRPCE1(.32945) Y="@7202";.3296;.32913;.3297;.3298;.3295;@7202;

 +1       ;

73        ;;S:$$DGERCK^DGRPCE1(72,.DGER) Y="@7302";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7301";.3291;.32912;.3292;.3293;.329;@7301;S:'$$YN^DGRPCE1(.32945) Y="@7302";.3296;.32913;.3297;.3298;.3295;@7302;

74        ;;S:'$$YN^DGRPCE1(.32101) Y="@7401";.32101;S:X'="Y" Y="@7401";.32104;.32105;@7401;S:'$$YN^DGRPCE1(.322016) Y="@7402";.322016;S:X'="Y" Y="@7402";.322017;.322018;@7402;

74000     ;;S:'$$YN^DGRPCE1(.322019) Y="@7403";.322019;S:X'="Y" Y="@7403";.32202;.322021;@7403;S:'$$YN^DGRPCE1(.3221) Y="@7404";.3221;S:X'="Y" Y="@7404";.3222;.3223;@7404;

74001     ;;S:'$$YN^DGRPCE1(.3224) Y="@7405";.3224;S:X'="Y" Y="@7405";.3225;.3226;@7405;S:'$$YN^DGRPCE1(.3227) Y="@7406";.3227;S:X'="Y" Y="@7406";.3228;.3229;@7406;

74002     ;;S:'$$YN^DGRPCE1(.32201) Y="@7407";.32201;S:X'="Y" Y="@7407";.322011;.322012;@7407;

75        ;;S:$$DGERCK^DGRPCE1(74,.DGER) Y="@7507";S:'$$YN^DGRPCE1(.32101) Y="@7501";.32101;S:X'="Y" Y="@7501";.32104;.32105;@7501;S:'$$YN^DGRPCE1(.322016) Y="@7502";.322016;S:X'="Y" Y="@7502";.322017;.322018;@7502;

75000     ;;S:'$$YN^DGRPCE1(.322019) Y="@7503";.322019;S:X'="Y" Y="@7503";.32202;.322021;@7503;S:'$$YN^DGRPCE1(.3221) Y="@7504";.3221;S:X'="Y" Y="@7504";.3222;.3223;@7504;

75001     ;;S:'$$YN^DGRPCE1(.3224) Y="@7505";.3224;S:X'="Y" Y="@7505";.3225;.3226;@7505;S:'$$YN^DGRPCE1(.3227) Y="@7506";.3227;S:X'="Y" Y="@7506";.3228;.3229;@7506;

75002     ;;S:'$$YN^DGRPCE1(.32201) Y="@7507";.32201;S:X'="Y" Y="@7507";.322011;.322012;@7507;

76        ;;S:$$DGERCK^DGRPCE1("74^75",.DGER) Y="@7607";S:'$$YN^DGRPCE1(.32101) Y="@7601";.32101;S:X'="Y" Y="@7601";.32104;.32105;@7601;S:'$$YN^DGRPCE1(.322016) Y="@7602";.322016;S:X'="Y" Y="@7602";.322017;.322018;@7602;

76000     ;;S:'$$YN^DGRPCE1(.322019) Y="@7603";.322019;S:X'="Y" Y="@7603";.32202;.322021;@7603;S:'$$YN^DGRPCE1(.3221) Y="@7604";.3221;S:X'="Y" Y="@7604";.3222;.3223;@7604;

76001     ;;S:'$$YN^DGRPCE1(.3224) Y="@7605";.3224;S:X'="Y" Y="@7605";.3225;.3226;@7605;S:'$$YN^DGRPCE1(.3227) Y="@7606";.3227;S:X'="Y" Y="@7606";.3228;.3229;@7606;

76002     ;;S:'$$YN^DGRPCE1(.32201) Y="@7607";.32201;S:X'="Y" Y="@7607";.322011;.322012;@7607;

77        ;;S:(($$DGERCK^DGRPCE1("37^38",.DGER))!('$$YN^DGRPCE1(.525))) Y="@77";.525;S:X'="Y" Y="@77";.526;.527;.528;@77;

78        ;;S:(($$DGERCK^DGRPCE1("39^40^68",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@78";.5291;S:X'="Y" Y="@78";.5292;.5293;.5294;@78;

79        ;;S:$$DGERCK^DGRPCE1("72^73",.DGER) Y="@7902";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@7901";.3291;.32912;.3292;.3293;.329;@7901;S:'$$YN^DGRPCE1(.32945) Y="@7902";.3296;.32913;.3297;.3298;.3295;@7902;

80        ;;S:(($$DGERCK^DGRPCE1("37^38^77",.DGER))!('$$YN^DGRPCE1(.525))) Y="@8001";.525;S:X'="Y" Y="@8001";.526;.527;.528;@8001;S:$$DGERCK^DGRPCE1("72^73^79",.DGER) Y="@8003";

80000     ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8002";.3291;.32912;.3292;.3293;.329;@8002;S:'$$YN^DGRPCE1(.32945) Y="@8003";.3296;.32913;.3297;.3298;.3295;@8003;

81        ;;S:(($$DGERCK^DGRPCE1("39^40^78",.DGER))!('$$YN^DGRPCE1(.5291))) Y="@8101";.5291;S:X'="Y" Y="@8101";.5292;.5293;.5294;@8101;S:$$DGERCK^DGRPCE1("72^73^79^80",.DGER) Y="@8103";

81000     ;;.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8102";.3291;.32912;.3292;.3293;.329;@8102;S:'$$YN^DGRPCE1(.32945) Y="@8103";.3296;.32913;.3297;.3298;.3295;@8103;

82        ;;S:($$DGERCK^DGRPCE1("74^75^76",.DGER)) Y="@8207";S:'$$YN^DGRPCE1(.32101) Y="@8201";.32101;S:X'="Y" Y="@8201";.32104;.32105;@8201;S:'$$YN^DGRPCE1(.322016) Y="@8202";.322016;

82000     ;;S:X'="Y" Y="@8202";.322017;.322018;@8202;S:'$$YN^DGRPCE1(.322019) Y="@8203";.322019;S:X'="Y" Y="@8203";.32202;.322021;@8203;S:'$$YN^DGRPCE1(.3221) Y="@8204";.3221;

82001     ;;S:X'="Y" Y="@8204";.3222;.3223;@8204;S:'$$YN^DGRPCE1(.3224) Y="@8205";.3224;S:X'="Y" Y="@8205";.3225;.3226;@8205;S:'$$YN^DGRPCE1(.3227) Y="@8206";.3227;S:X'="Y" Y="@8206";

82002     ;;.3228;.3229;@8206;S:'$$YN^DGRPCE1(.32201) Y="@8207";.32201;S:X'="Y" Y="@8207";.322011;.322012;@8207;S:($$DGERCK^DGRPCE1("72^73^79^80^81",.DGER)) Y="@8209";

82003     ;;S:$$NEWMSE^DGRPCE1(DFN) Y="@8209";.325;.32911;.326;.327;.324;S:'$$YN^DGRPCE1(.3285) Y="@8208";.3291;.32912;.3292;.3293;.329;@8208;S:'$$YN^DGRPCE1(.32945) Y="@8209";.3296;.32913;.3297;.3298;.3295;@8209;

83        ;;S:$$DGERCK^DGRPCE1(73,.DGER) Y="@83";@8295;D SET32^DGRPE(DA,.DIPA,1);.325;S DIPA("X1")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@8296";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y="@8295";

83000     ;;@8296;D:DIPA("X1")'="" WARN32^DGRPE(DIPA("X1"),.DIPA,1,.Y) S:$E(Y,1,4)="@601" Y=.326;.32911;.326;.327;

83001     ;;.3285//NO;S:X'="Y" Y="@83";D SET32^DGRPE(DA,.DIPA,2);.3291;S DIPA("X2")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@832";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3291";S Y=.3292;

83002     ;;@832;D:DIPA("X2")'="" WARN32^DGRPE(DIPA("X2"),.DIPA,2,.Y) S:$E(Y,1,4)="@601" Y=.3292;.32912;.3292;.3293;

83003     ;;.32945//NO;S:X'="Y" Y="@83";D SET32^DGRPE(DA,.DIPA,3);.3296;S DIPA("X3")=X S:X']"" Y="@83";S:$$FV^DGRPMS(X)'=1 Y="@833";.3214;I X']"" W !?4,$C(7),"Proof is required for Filipino Vet." S Y=".3296";S Y=.3297;@833;

83004     ;;D:DIPA("X3")'="" WARN32^DGRPE(DIPA("X3"),.DIPA,3,.Y) S:$E(Y,1,4)="@601" Y=.3297;.32913;.3297;.3298;@83;

84        ;;.3214;

85        ;;1901;

86        ;;1901;

87        ;;D VETTYPE^DGRPE1;D MSG^DGRPE1 S Y=0;@114;K DGRDCHG;D DR^DGRPE1;.302;.3721;D EFF^DGRPE1;D:$G(DGRDCHG) BULL^DGRPE1;K DGRDCHG;

88        ;;D EN^DGREGTED(DFN,"TEMP");

301       ;;.01;

303       ;;.02;

304       ;;.02;

306       ;;.09;

307       ;;.0906;

308       ;;.351;

402       ;;.381;

403       ;;.382;

406       ;;.313;

407       ;;.3611;

501       ;;.525;

502       ;;.3602;

503       ;;.3603;

504       ;;.32102;

505       ;;.32103;

506       ;;.322013;

507       ;;.32103;.3212;

516       ;;.03;

517       ;;.03;

 +1       ;

YN(FLD,DFN,FILE) ; return binary for YES/NO flds in the Patient (#2) file

 +1        NEW RTN

 +2        IF $GET(FLD)']""

               QUIT ""

 +3        IF $GET(FILE)=""

               SET FILE=2

           IF $GET(DFN)=""

               SET DFN=$GET(DA)

           IF $GET(DFN)']""

               QUIT ""

 +4        SET RTN=$$GET1^DIQ(FILE,DFN_",",FLD,"I")

 +5        QUIT $SELECT(RTN=1:1,RTN=0:0,RTN="Y":1,RTN="N":0,1:"")

 +6       ;

DGERCK(STR,DGER) ;do any of the STR errors exist in DGER?

 +1        NEW RTN,X

 +2        IF $GET(STR)']""

               QUIT 0

           IF $GET(DGER)']""

               QUIT 0

 +3        SET RTN=0

           FOR X=1:1

               IF RTN!($PIECE(STR,"^",X)="")

                   QUIT 

               IF DGER[(","_$PIECE(STR,"^",X)_",")

                   SET RTN=1

 +4        QUIT RTN

 +5       ;

NEWMSE(DFN) ;Is there data in the new MSE sub-file #2.3216?

 +1        IF $GET(DFN)=""

               SET DFN=$GET(DA)

 +2        IF $GET(DFN)=""

               QUIT 0

 +3        IF $ORDER(^DPT(DFN,.3216,0))

               QUIT 1

 +4        QUIT 0

 +5       ;

MSERR()   ;Are there MSE data inconsistencies?

 +1        NEW ERR,RTN

 +2        SET RTN=0

 +3        FOR ERR=67,72,73,79,81,82,83

               IF DGER[ERR

                   SET RTN=1

 +4        QUIT RTN