- DGRPCE ;ALB/MRL,KV,PJR,BRM,ERC,TDM,LBD,ARF - CONSISTENCY CHECKER, EDIT INCONSISTENCIES ;10/20/10 3:52pm
- ;;5.3;Registration;**121,122,175,297,342,451,626,689,653,754,797,855,952,1075**;Aug 13, 1993;Build 13
- ;Per VHA Directive 6402, this routine should not be modified.
- ;
- ;KV;11/15/00;DG*5.3*297;Disable addition of CD Elig Code in Reg. Screens
- ; ;Adding CD Elig Codes in Load/Edit Screen used to
- ; ;cause undefined line tag error.
- ;
- S DGVTYN=$P($G(^DPT(DFN,"VET")),"^",1),DGDR="DR",(DR,DGD,DGDRC,DGCCF)="",DGASK=",",DGER=","_DGER D ^DGRPCE1
- S DGEK=0 F I=9,10,11,12,13,14,18,19,20,22,24,36,51 Q:DGEK I DGER[(","_I_",") S DGEK=1 Q
- I 'DGKEY(1) D:DGEK ELDR S I=15 D SASK S I=23 D SASK
- F I=29,30,31,32,33,43,44,45,48,56 D SASK,MON:DGCCF S DGCCF=0
- G NKEY:DGKEY(3) F I=25,26,27,28,34,35 D SASK
- I DGASK'[26 F I=41,42 I DGASK'[41 D SASK
- I DGASK'[27 S I=60 I DGASK'[25 D SASK
- I DGASK'[34 F I=37,38 I DGASK'[37 D SASK
- I DGASK'[35 F I=39,40 I DGASK'[39 D SASK
- NKEY D ^DGRPCE1
- I $S(DGER[49:1,(DGER[",50,"):1,(DGER[52):1,1:0) D
- .I $G(DGPRFLG) D PREG^IBCNBME(DFN) Q
- .D REG^IBCNBME(DFN)
- .Q
- D Q
- ;*952 Stop it asking for Patient Type twice
- I DR["391;391;" S DR=$P(DR,"391;",1)_$P(DR,"391;",2,999)
- S DIE="^DPT(",(DA,Y)=DFN D ^DIE:$D(DR)
- I DGER[54 D GETREL^DGMTU11(DFN,"SD",$$LYR^DGMTSCU1(DT)) D
- . I $D(DGREL("S")),($$SSN^DGMTU1(+DGREL("S"))']"") D ASKSSN(DGREL("S"))
- . F DGDEP=0:0 S DGDEP=$O(DGREL("D",DGDEP)) Q:'DGDEP I $$SSN^DGMTU1(+DGREL("D",DGDEP))']"" D ASKSSN(DGREL("D",DGDEP))
- ;
- I DGER[59 D CATDIB
- I DGER["82" D EN2^DGRP6CL
- ;
- ;Use Screen 6.1 to edit inconsistencies with MSE data (DG*5.3*797)
- ;DG*5.3*855
- I $$MSERR^DGRPCE1,$G(DGVTYN)="Y" D EN^DGRP61(DFN)
- ;
- I (DGER[301)!(DGER[303)!(DGER[304)!(DGER[307) D
- . N DEPFLD
- . S DEPFLD=""
- . I DGER[301 S DEPFLD=".01;"
- . I (DGER[303)!(DGER[304) S DEPFLD=DEPFLD_".02;"
- . I DGER[307 S DEPFLD=DEPFLD_".1;"
- . D GETREL^DGMTU11(DFN,"SD",$$LYR^DGMTSCU1(DT))
- . I $D(DGREL("S")) D DEPEDT(DGREL("S"),DEPFLD)
- . F DGDEP=0:0 S DGDEP=$O(DGREL("D",DGDEP)) Q:'DGDEP D DEPEDT(DGREL("D",DGDEP),DEPFLD)
- ;
- K DGREL,DGDEP
- KVAR K DR,DGEDCN,DGCT,DGER,DGINC55,DGRPADI,DGRPOUT,DGVTYN
- Q K %,C,DA,DGASK,DGCCF,DGCT1,DGCT2,DGCT3,DGD,DGD1,DGD2,DGDR,DGDRC,DGECODE,DGEDIT,DGEK,DGKEY,DGP,DGRPADI,DGRPE,DIC,DIE,DIK,I,I1,J,X,X1,X2
- K DGCOMLOC,DGCOMBR,FRDT,DGFRDT,DGCTZ7
- D KVAR^VADPT
- Q
- SASK I DGER[(","_I_","),DGASK'[(","_I_",") S DGD=$P($T(@I),";;",2,999),DGASK=DGASK_I_",",DGCCF=1 D SAVE
- 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
- ELDR S DGASK=DGASK_"9,10,11,12,13,14,18,19,20,24,29,30,31,34,36,37,38,"
- I 'DGKEY(1) S DGD="391;1901;S DGVTYN=$S($D(^DPT(DFN,""VET"")):$P(^(""VET""),""^"",1),1:"""");S:X'=""Y"" Y=""@1"";.301;S:X'=""Y"" Y=""@1"";.302;@1;" D SAVE
- I 'DGKEY(2) F I=29,30,31 S DGD=$P($T(@I),";;",2,999) D SAVE
- ;DG*5.3*855
- D:DGD]"" SAVE I 'DGKEY(3) S DGD=$P($T(34),";;",2,999) D SAVE
- I 'DGKEY(1) D ELIG^DGRPCE1
- Q
- MON I $S(I<40:1,I=56:1,1:0) D SAVE Q
- I $S(I<46:1,1:0),DGASK'[(","_(I-14)_",") D SAVE Q
- I DGASK'[(","_(I-15)_",") D SAVE
- Q
- ;
- 15 ;;.152;S:X']"" Y="@15";S DIE("NO^")="";.307;I X']"" W !!,*7,"But I need a reason why this applicant is ineligible!" S Y=.152;@15;K DIE("NO^");
- 23 ;;.3611;S:X'="V" Y="@23";.3612;S DIE("NO^")="";I X']"" W !!,*7,"But I need to know the date eligibility was verified!";@23;K DIE("NO^");
- 25 ;;.323;.32102;S:X'="Y" Y="@25";.32107;.3211;.32109;.3213;@25;
- 26 ;;
- 27 ;;
- 28 ;;
- ;DG*5.3*1075: Set default to NO for NON-VETERANS only at the three receiving prompts: RECEIVING A&A BENEFITS?(#.36205), RECEIVING HOUSEBOUND BENEFITS?(#36215), RECEIVING A VA PENSION?(#.36235)
- 29 ;;I DGVTYN'="Y" S Y="@291";.36205;S Y="@292";@291;.36205//NO;@292;S:X'="Y" Y="@29";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim A&A" S Y=.36205;.36295;@29;
- 30 ;;I DGVTYN'="Y" S Y="@301";.36215;S Y="@302";@301;.36215//NO;@302;S:X'="Y" Y="@30";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim HOUSEBOUND" S Y=.36215;.36295;@30;
- 31 ;;I DGVTYN'="Y" S Y="@311";.36235;S Y="@312";@311;.36235//NO;@312;S:X'="Y" Y="@31";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim VA PENSION" S Y=.36235;.36295;@31;
- 32 ;;.36255;S:X'="Y" Y="@32";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim MIL. RET." S Y=.36255;.3625;@32;
- 33 ;;
- 34 ;;.525;S:X'="Y" Y="@34";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim POW STATUS" S Y=.525;.526:.528;@34;
- 35 ;;
- 37 ;;.525;S:X'="Y" Y="@37";.526:.528;@37;
- 38 ;;.525;S:X'="Y" Y="@38";.526:.528;@38;
- 39 ;;.5291;S:X'="Y" Y="@39";.5292:.5294;@39;
- 40 ;;.5291;S:X'="Y" Y="@40";.5292:.5294;@40;
- 41 ;;.32101;S:X'="Y" Y="@41";.32104;.32105;@41;
- 42 ;;.32101;S:X'="Y" Y="@42";.32104;.32105;@42;
- 43 ;;
- 44 ;;
- 45 ;;
- 46 ;;
- 47 ;;
- 48 ;;.36265;S:X'="Y" Y="@48";.3626;@48;
- ;DG*5.3*855
- 51 ;;S Y="@51";I DGVTYN'="Y" S Y="@51";.324:.328;@51;
- 56 ;;.3025;S:X'="Y" Y="@56";.36295;@56;
- 60 ;;.32102;S:X'="Y" Y="@60";.32107;.3211;.32109;.3213;@60;
- ;
- ; NOTE: #46 & 47 REMOVED WITH PIMS5.3
- ;
- ASKSSN(DEP) ;edit ssns if missing
- ;
- ; input: DEP as string for dependent (from GETREL)
- ;
- W !,$$NAME^DGMTU1(+DEP)
- S DA=+$P(DEP,"^",2),DIE="^DGPR(408.13,",DR=.09 D ^DIE
- PS ;
- S DA=+$P(DEP,"^",2),DIE="^DGPR(408.13,",DR=.09 D ^DIE
- I $$GET1^DIQ(408.13,DA_",",.09)["P" D
- . S DR=.1,DA=$P(DA,";") D ^DIE
- . I X']"" W !,"If SSN is a Pseudo SSN, the Pseudo SSN Reason field is required." G PS
- K DA,DR,DIE
- Q
- ;
- CATDIB ;
- ;Could be inconsistent because there is the catastrophic disability
- ;code without supporting information, or visa versa
- ;
- N DGCDIS,CODE,INFO
- S (INFO,CODE)=0
- I $$GET^DGENCDA(DFN,.DGCDIS),DGCDIS("DATE") S INFO=1
- S CODE=$$HASCAT^DGENCDA(DFN)
- I CODE D Q
- .W !!,">>> Catastrophically Disabled eligibility requires additional information <<<"
- .D EDITCD^DGENCD(DFN)
- I INFO D
- . ;KV;11/15/00;DG*5.3*297;Start of modifications
- . W !!,"The patient record indicates that a determination was made "
- . W "that the patient",!,"is catastrophically disabled."
- . W !!,"To add Catastrophic Disability Eligibility Code(s), please use "
- . W "the menu option",!,"DGEN PATIENT ENROLLMENT.",!!
- .I $$ASKDEL() D
- .. I $$DELETE^DGENCDA1(DFN) D
- ...W !,">>> Determination Deleted <<<"
- ..;
- ..;could fail if lock could not be obtained
- ..E W !,"Catastrophic disability determination can not be deleted at this time.",!,"Please try again later."
- ;KV;11/15/00;DG*5.3*297;End of modifications
- Q
- ;
- ASKDEL() ;
- ;ask whether to delete catastrophic disability determination
- N DIR
- S DIR(0)="Y"
- ;KV;11/15/00;DG*5.3*297;Cosmetic change for DIR("A")
- S DIR("A")="Do you want to delete the determination showing that patient is catastrophically disabled"
- S DIR("B")="YES"
- D ^DIR
- Q:$D(DIRUT) 0
- Q $S(Y=1:1,1:0)
- ;
- DEPEDT(DEP,FLD) ;edit dependent fields if missing or invalid
- ;
- ; input: DEP as string for dependent (from GETREL)
- ; FLD as 408.13 field(s) to edit (separated by ';')
- ;
- Q:$G(FLD)=""
- W !!,$$NAME^DGMTU1(+DEP)
- S DA=+$P(DEP,"^",2),DIE="^DGPR(408.13,",DR=FLD D ^DIE
- K DA,DR,DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPCE 7165 printed Feb 19, 2025@00:22 Page 2
- DGRPCE ;ALB/MRL,KV,PJR,BRM,ERC,TDM,LBD,ARF - CONSISTENCY CHECKER, EDIT INCONSISTENCIES ;10/20/10 3:52pm
- +1 ;;5.3;Registration;**121,122,175,297,342,451,626,689,653,754,797,855,952,1075**;Aug 13, 1993;Build 13
- +2 ;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;KV;11/15/00;DG*5.3*297;Disable addition of CD Elig Code in Reg. Screens
- +5 ; ;Adding CD Elig Codes in Load/Edit Screen used to
- +6 ; ;cause undefined line tag error.
- +7 ;
- +8 SET DGVTYN=$PIECE($GET(^DPT(DFN,"VET")),"^",1)
- SET DGDR="DR"
- SET (DR,DGD,DGDRC,DGCCF)=""
- SET DGASK=","
- SET DGER=","_DGER
- DO ^DGRPCE1
- +9 SET DGEK=0
- FOR I=9,10,11,12,13,14,18,19,20,22,24,36,51
- if DGEK
- QUIT
- IF DGER[(","_I_",")
- SET DGEK=1
- QUIT
- +10 IF 'DGKEY(1)
- if DGEK
- DO ELDR
- SET I=15
- DO SASK
- SET I=23
- DO SASK
- +11 FOR I=29,30,31,32,33,43,44,45,48,56
- DO SASK
- if DGCCF
- DO MON
- SET DGCCF=0
- +12 if DGKEY(3)
- GOTO NKEY
- FOR I=25,26,27,28,34,35
- DO SASK
- +13 IF DGASK'[26
- FOR I=41,42
- IF DGASK'[41
- DO SASK
- +14 IF DGASK'[27
- SET I=60
- IF DGASK'[25
- DO SASK
- +15 IF DGASK'[34
- FOR I=37,38
- IF DGASK'[37
- DO SASK
- +16 IF DGASK'[35
- FOR I=39,40
- IF DGASK'[39
- DO SASK
- NKEY DO ^DGRPCE1
- +1 IF $SELECT(DGER[49:1,(DGER[",50,"):1,(DGER[52):1,1:0)
- Begin DoDot:1
- +2 IF $GET(DGPRFLG)
- DO PREG^IBCNBME(DFN)
- QUIT
- +3 DO REG^IBCNBME(DFN)
- +4 QUIT
- End DoDot:1
- +5 DO Q
- +6 ;*952 Stop it asking for Patient Type twice
- +7 IF DR["391;391;"
- SET DR=$PIECE(DR,"391;",1)_$PIECE(DR,"391;",2,999)
- +8 SET DIE="^DPT("
- SET (DA,Y)=DFN
- if $DATA(DR)
- DO ^DIE
- +9 IF DGER[54
- DO GETREL^DGMTU11(DFN,"SD",$$LYR^DGMTSCU1(DT))
- Begin DoDot:1
- +10 IF $DATA(DGREL("S"))
- IF ($$SSN^DGMTU1(+DGREL("S"))']"")
- DO ASKSSN(DGREL("S"))
- +11 FOR DGDEP=0:0
- SET DGDEP=$ORDER(DGREL("D",DGDEP))
- if 'DGDEP
- QUIT
- IF $$SSN^DGMTU1(+DGREL("D",DGDEP))']""
- DO ASKSSN(DGREL("D",DGDEP))
- End DoDot:1
- +12 ;
- +13 IF DGER[59
- DO CATDIB
- +14 IF DGER["82"
- DO EN2^DGRP6CL
- +15 ;
- +16 ;Use Screen 6.1 to edit inconsistencies with MSE data (DG*5.3*797)
- +17 ;DG*5.3*855
- +18 IF $$MSERR^DGRPCE1
- IF $GET(DGVTYN)="Y"
- DO EN^DGRP61(DFN)
- +19 ;
- +20 IF (DGER[301)!(DGER[303)!(DGER[304)!(DGER[307)
- Begin DoDot:1
- +21 NEW DEPFLD
- +22 SET DEPFLD=""
- +23 IF DGER[301
- SET DEPFLD=".01;"
- +24 IF (DGER[303)!(DGER[304)
- SET DEPFLD=DEPFLD_".02;"
- +25 IF DGER[307
- SET DEPFLD=DEPFLD_".1;"
- +26 DO GETREL^DGMTU11(DFN,"SD",$$LYR^DGMTSCU1(DT))
- +27 IF $DATA(DGREL("S"))
- DO DEPEDT(DGREL("S"),DEPFLD)
- +28 FOR DGDEP=0:0
- SET DGDEP=$ORDER(DGREL("D",DGDEP))
- if 'DGDEP
- QUIT
- DO DEPEDT(DGREL("D",DGDEP),DEPFLD)
- End DoDot:1
- +29 ;
- +30 KILL DGREL,DGDEP
- KVAR KILL DR,DGEDCN,DGCT,DGER,DGINC55,DGRPADI,DGRPOUT,DGVTYN
- Q KILL %,C,DA,DGASK,DGCCF,DGCT1,DGCT2,DGCT3,DGD,DGD1,DGD2,DGDR,DGDRC,DGECODE,DGEDIT,DGEK,DGKEY,DGP,DGRPADI,DGRPE,DIC,DIE,DIK,I,I1,J,X,X1,X2
- +1 KILL DGCOMLOC,DGCOMBR,FRDT,DGFRDT,DGCTZ7
- +2 DO KVAR^VADPT
- +3 QUIT
- SASK IF DGER[(","_I_",")
- IF DGASK'[(","_I_",")
- SET DGD=$PIECE($TEXT(@I),";;",2,999)
- SET DGASK=DGASK_I_","
- SET DGCCF=1
- DO SAVE
- +1 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
- ELDR SET DGASK=DGASK_"9,10,11,12,13,14,18,19,20,24,29,30,31,34,36,37,38,"
- +1 IF 'DGKEY(1)
- SET DGD="391;1901;S DGVTYN=$S($D(^DPT(DFN,""VET"")):$P(^(""VET""),""^"",1),1:"""");S:X'=""Y"" Y=""@1"";.301;S:X'=""Y"" Y=""@1"";.302;@1;"
- DO SAVE
- +2 IF 'DGKEY(2)
- FOR I=29,30,31
- SET DGD=$PIECE($TEXT(@I),";;",2,999)
- DO SAVE
- +3 ;DG*5.3*855
- +4 if DGD]""
- DO SAVE
- IF 'DGKEY(3)
- SET DGD=$PIECE($TEXT(34),";;",2,999)
- DO SAVE
- +5 IF 'DGKEY(1)
- DO ELIG^DGRPCE1
- +6 QUIT
- MON IF $SELECT(I<40:1,I=56:1,1:0)
- DO SAVE
- QUIT
- +1 IF $SELECT(I<46:1,1:0)
- IF DGASK'[(","_(I-14)_",")
- DO SAVE
- QUIT
- +2 IF DGASK'[(","_(I-15)_",")
- DO SAVE
- +3 QUIT
- +4 ;
- 15 ;;.152;S:X']"" Y="@15";S DIE("NO^")="";.307;I X']"" W !!,*7,"But I need a reason why this applicant is ineligible!" S Y=.152;@15;K DIE("NO^");
- 23 ;;.3611;S:X'="V" Y="@23";.3612;S DIE("NO^")="";I X']"" W !!,*7,"But I need to know the date eligibility was verified!";@23;K DIE("NO^");
- 25 ;;.323;.32102;S:X'="Y" Y="@25";.32107;.3211;.32109;.3213;@25;
- 26 ;;
- 27 ;;
- 28 ;;
- +1 ;DG*5.3*1075: Set default to NO for NON-VETERANS only at the three receiving prompts: RECEIVING A&A BENEFITS?(#.36205), RECEIVING HOUSEBOUND BENEFITS?(#36215), RECEIVING A VA PENSION?(#.36235)
- 29 ;;I DGVTYN'="Y" S Y="@291";.36205;S Y="@292";@291;.36205//NO;@292;S:X'="Y" Y="@29";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim A&A" S Y=.36205;.36295;@29;
- 30 ;;I DGVTYN'="Y" S Y="@301";.36215;S Y="@302";@301;.36215//NO;@302;S:X'="Y" Y="@30";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim HOUSEBOUND" S Y=.36215;.36295;@30;
- 31 ;;I DGVTYN'="Y" S Y="@311";.36235;S Y="@312";@311;.36235//NO;@312;S:X'="Y" Y="@31";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim VA PENSION" S Y=.36235;.36295;@31;
- 32 ;;.36255;S:X'="Y" Y="@32";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim MIL. RET." S Y=.36255;.3625;@32;
- 33 ;;
- 34 ;;.525;S:X'="Y" Y="@34";I DGVTYN'="Y" W !,"Patient not a veteran-can't claim POW STATUS" S Y=.525;.526:.528;@34;
- 35 ;;
- 37 ;;.525;S:X'="Y" Y="@37";.526:.528;@37;
- 38 ;;.525;S:X'="Y" Y="@38";.526:.528;@38;
- 39 ;;.5291;S:X'="Y" Y="@39";.5292:.5294;@39;
- 40 ;;.5291;S:X'="Y" Y="@40";.5292:.5294;@40;
- 41 ;;.32101;S:X'="Y" Y="@41";.32104;.32105;@41;
- 42 ;;.32101;S:X'="Y" Y="@42";.32104;.32105;@42;
- 43 ;;
- 44 ;;
- 45 ;;
- 46 ;;
- 47 ;;
- 48 ;;.36265;S:X'="Y" Y="@48";.3626;@48;
- +1 ;DG*5.3*855
- 51 ;;S Y="@51";I DGVTYN'="Y" S Y="@51";.324:.328;@51;
- 56 ;;.3025;S:X'="Y" Y="@56";.36295;@56;
- 60 ;;.32102;S:X'="Y" Y="@60";.32107;.3211;.32109;.3213;@60;
- +1 ;
- +2 ; NOTE: #46 & 47 REMOVED WITH PIMS5.3
- +3 ;
- ASKSSN(DEP) ;edit ssns if missing
- +1 ;
- +2 ; input: DEP as string for dependent (from GETREL)
- +3 ;
- +4 WRITE !,$$NAME^DGMTU1(+DEP)
- +5 SET DA=+$PIECE(DEP,"^",2)
- SET DIE="^DGPR(408.13,"
- SET DR=.09
- DO ^DIE
- PS ;
- +1 SET DA=+$PIECE(DEP,"^",2)
- SET DIE="^DGPR(408.13,"
- SET DR=.09
- DO ^DIE
- +2 IF $$GET1^DIQ(408.13,DA_",",.09)["P"
- Begin DoDot:1
- +3 SET DR=.1
- SET DA=$PIECE(DA,";")
- DO ^DIE
- +4 IF X']""
- WRITE !,"If SSN is a Pseudo SSN, the Pseudo SSN Reason field is required."
- GOTO PS
- End DoDot:1
- +5 KILL DA,DR,DIE
- +6 QUIT
- +7 ;
- CATDIB ;
- +1 ;Could be inconsistent because there is the catastrophic disability
- +2 ;code without supporting information, or visa versa
- +3 ;
- +4 NEW DGCDIS,CODE,INFO
- +5 SET (INFO,CODE)=0
- +6 IF $$GET^DGENCDA(DFN,.DGCDIS)
- IF DGCDIS("DATE")
- SET INFO=1
- +7 SET CODE=$$HASCAT^DGENCDA(DFN)
- +8 IF CODE
- Begin DoDot:1
- +9 WRITE !!,">>> Catastrophically Disabled eligibility requires additional information <<<"
- +10 DO EDITCD^DGENCD(DFN)
- End DoDot:1
- QUIT
- +11 IF INFO
- Begin DoDot:1
- +12 ;KV;11/15/00;DG*5.3*297;Start of modifications
- +13 WRITE !!,"The patient record indicates that a determination was made "
- +14 WRITE "that the patient",!,"is catastrophically disabled."
- +15 WRITE !!,"To add Catastrophic Disability Eligibility Code(s), please use "
- +16 WRITE "the menu option",!,"DGEN PATIENT ENROLLMENT.",!!
- +17 IF $$ASKDEL()
- Begin DoDot:2
- +18 IF $$DELETE^DGENCDA1(DFN)
- Begin DoDot:3
- +19 WRITE !,">>> Determination Deleted <<<"
- End DoDot:3
- +20 ;
- +21 ;could fail if lock could not be obtained
- +22 IF '$TEST
- WRITE !,"Catastrophic disability determination can not be deleted at this time.",!,"Please try again later."
- End DoDot:2
- End DoDot:1
- +23 ;KV;11/15/00;DG*5.3*297;End of modifications
- +24 QUIT
- +25 ;
- ASKDEL() ;
- +1 ;ask whether to delete catastrophic disability determination
- +2 NEW DIR
- +3 SET DIR(0)="Y"
- +4 ;KV;11/15/00;DG*5.3*297;Cosmetic change for DIR("A")
- +5 SET DIR("A")="Do you want to delete the determination showing that patient is catastrophically disabled"
- +6 SET DIR("B")="YES"
- +7 DO ^DIR
- +8 if $DATA(DIRUT)
- QUIT 0
- +9 QUIT $SELECT(Y=1:1,1:0)
- +10 ;
- DEPEDT(DEP,FLD) ;edit dependent fields if missing or invalid
- +1 ;
- +2 ; input: DEP as string for dependent (from GETREL)
- +3 ; FLD as 408.13 field(s) to edit (separated by ';')
- +4 ;
- +5 if $GET(FLD)=""
- QUIT
- +6 WRITE !!,$$NAME^DGMTU1(+DEP)
- +7 SET DA=+$PIECE(DEP,"^",2)
- SET DIE="^DGPR(408.13,"
- SET DR=FLD
- DO ^DIE
- +8 KILL DA,DR,DIE
- +9 QUIT