DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM,DJS - Catastrophic Disability Protocols; 02/17/2005
;;5.3;Registration;**121,232,387,451,610,894**;Aug 13,1993;Build 48
;
EN(DFN) ;Entry point for DGENCD CATASTROPHIC DISABILITY protocol
D EN^DGENLCD(DFN)
D:DFN BLD^DGENL
Q
;
ADDCD ;Entry point for DGENCD ADD/EDIT CATASTROPHIC DISABILITY protocol
; Input -- DFN Patient IEN
; Output -- VALMBCK R =Refresh screen
N YN,EXIT,PRI,CDSITE
S VALMBCK="",EXIT=0
D FULL^VALM1
I $$CDTYPE^DGENCDA(DFN) D ;was determination by physical exam?
.S CDSITE=$$CHKSITE^DGENCDA(DFN)
.I CDSITE D ;CD was determined by this site
..D BMES^XPDUTL("This veteran is currently determined to be Catastrophically")
..D MES^XPDUTL("Disabled. You may not change this evaluation unless it is due")
..D MES^XPDUTL("to an error in data entry.")
..S YN=$$YN("Is this edit due to an error in data entry")
..D:"N^"[$E($G(YN))
...D BMES^XPDUTL("Additional CD evaluations are not necessary for this")
...D MES^XPDUTL("Veteran, as they are currently determined to be CD. If")
...D MES^XPDUTL("this is an edit due to an error, please return to the")
...D MES^XPDUTL("Add/Edit action and answer YES to this prompt.")
...S EXIT=1
.E D ; CD was determined by another site
..S SITEINF=$$NS^XUAF4($P(CDSITE,"^",2))
..D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
..D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
..D MES^XPDUTL("if it is necessary to edit this evaluation.")
..S EXIT=1
..S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
I EXIT S VALMBCK="R" Q
;
S PRI=$$PRIORITY^DGENA(DFN)
I PRI,PRI'>4 D
. W:$X !
. W !,"According to the veteran's current enrollment record, the",!
. W "assignment of a Catastrophically Disabled Status will not",!
. W "improve his/her enrollment priority.",!!
. S YN=$$YN("Do you still want to perform a review")
. I "N^"[$E($G(YN)) S EXIT=1
I 'EXIT D EDITCD^DGENCD(DFN),INIT^DGENLCD
S VALMBCK="R"
Q
;
DELETECD ;Entry point for DGENCD DELETE CATASTROPHIC DISABILITY protocol
; Input -- DFN Patient IEN
; Output -- VALMBCK R =Refresh screen
N DGCDIS
S VALMBCK=""
D FULL^VALM1
I $$GET^DGENCDA(DFN,.DGCDIS),'$D(DGCDIS("DESCR")) D
.W !!,">>> No Catastrophic Disabilities exist for this veteran.<<<"
.W !!,"VETERAN IS NOT CATASTROPHICALLY DISABLED"
.S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
.S DGCDIS("VCD")="N"
.N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCDIS(I)="" ; DG*5.3*894
E D
.I $$RUSURE(DFN) D
. . S DGCDIS("VCD")="N"
. . N I,ERROR
. . F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCDIS(I)="" ; DG*5.3*894
. . F I=1:1 Q:'$D(DGCDIS("DESCR",I)) K DGCDIS("DESCR",I)
. . I $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR)
D INIT^DGENLCD
S VALMBCK="R"
Q
;
RUSURE(DFN) ;
;Description: Asks user 'Are you sure?'
;Input: DFN is the patient ien
;Output: Function Value returns 0 or 1
;
N DIR,SITE,SITEINF,DIROUT,DIRUT,DTOUT,DUOUT,NOERR
S SITE=$$CHKSITE^DGENCDA(DFN)
I '$P(SITE,"^") D Q 0 ;CD was not determined at this site
.S SITEINF=$$NS^XUAF4($P(SITE,"^",2))
.D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
.D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
.D MES^XPDUTL("if it is necessary to delete this evaluation.")
.S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
; was this entered in error?
I $$CDTYPE^DGENCDA(DFN) D Q:$G(NOERR) 0
.D BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you")
.D MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.")
.S DIR(0)="Y",DIR("B")="NO"
.S DIR("A")="Is this deletion due to an error in data entry"
.D ^DIR
.I $G(DIRUT)!$G(DUOUT)!$G(DIROUT)!$G(DTOUT)!('$G(Y)) S NOERR=1
.K DIR,Y
;
S DIR(0)="Y"
S DIR("A")="Are you sure that the Catastrophic Disability should be deleted"
S DIR("B")="NO"
I $$HASCAT^DGENCDA(DFN) D
. W !!,">>> Deleting the Catastrophic Disability information will <<<",!
. W ">>> also delete all supporting fields, including Descriptors. <<<",!
D ^DIR
Q:$D(DIRUT) 0
Q Y
;
YN(PROMPT,DFLT) ; Ask user a yes/no question.
S DFLT=$E($G(DFLT,"N"))
N YN,%,%Y
F D Q:"YN^"[YN
. W PROMPT
. S %=$S(DFLT="N":2,DFLT="Y":1,1:0)
. D YN^DICN
. W !
. S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
. I YN["?" W ?5,"You can just enter 'Y' or 'N'.",!!
Q YN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCD1 4582 printed Oct 16, 2024@18:43:05 Page 2
DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM,DJS - Catastrophic Disability Protocols; 02/17/2005
+1 ;;5.3;Registration;**121,232,387,451,610,894**;Aug 13,1993;Build 48
+2 ;
EN(DFN) ;Entry point for DGENCD CATASTROPHIC DISABILITY protocol
+1 DO EN^DGENLCD(DFN)
+2 if DFN
DO BLD^DGENL
+3 QUIT
+4 ;
ADDCD ;Entry point for DGENCD ADD/EDIT CATASTROPHIC DISABILITY protocol
+1 ; Input -- DFN Patient IEN
+2 ; Output -- VALMBCK R =Refresh screen
+3 NEW YN,EXIT,PRI,CDSITE
+4 SET VALMBCK=""
SET EXIT=0
+5 DO FULL^VALM1
+6 ;was determination by physical exam?
IF $$CDTYPE^DGENCDA(DFN)
Begin DoDot:1
+7 SET CDSITE=$$CHKSITE^DGENCDA(DFN)
+8 ;CD was determined by this site
IF CDSITE
Begin DoDot:2
+9 DO BMES^XPDUTL("This veteran is currently determined to be Catastrophically")
+10 DO MES^XPDUTL("Disabled. You may not change this evaluation unless it is due")
+11 DO MES^XPDUTL("to an error in data entry.")
+12 SET YN=$$YN("Is this edit due to an error in data entry")
+13 if "N^"[$EXTRACT($GET(YN))
Begin DoDot:3
+14 DO BMES^XPDUTL("Additional CD evaluations are not necessary for this")
+15 DO MES^XPDUTL("Veteran, as they are currently determined to be CD. If")
+16 DO MES^XPDUTL("this is an edit due to an error, please return to the")
+17 DO MES^XPDUTL("Add/Edit action and answer YES to this prompt.")
+18 SET EXIT=1
End DoDot:3
End DoDot:2
+19 ; CD was determined by another site
IF '$TEST
Begin DoDot:2
+20 SET SITEINF=$$NS^XUAF4($PIECE(CDSITE,"^",2))
+21 DO BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$PIECE(SITEINF,"^",2))
+22 DO MES^XPDUTL("Please Contact Site "_$PIECE(SITEINF,"^"))
+23 DO MES^XPDUTL("if it is necessary to edit this evaluation.")
+24 SET EXIT=1
+25 SET DIR(0)="EA"
SET DIR("A")="Press return to continue..."
DO ^DIR
End DoDot:2
End DoDot:1
+26 IF EXIT
SET VALMBCK="R"
QUIT
+27 ;
+28 SET PRI=$$PRIORITY^DGENA(DFN)
+29 IF PRI
IF PRI'>4
Begin DoDot:1
+30 if $X
WRITE !
+31 WRITE !,"According to the veteran's current enrollment record, the",!
+32 WRITE "assignment of a Catastrophically Disabled Status will not",!
+33 WRITE "improve his/her enrollment priority.",!!
+34 SET YN=$$YN("Do you still want to perform a review")
+35 IF "N^"[$EXTRACT($GET(YN))
SET EXIT=1
End DoDot:1
+36 IF 'EXIT
DO EDITCD^DGENCD(DFN)
DO INIT^DGENLCD
+37 SET VALMBCK="R"
+38 QUIT
+39 ;
DELETECD ;Entry point for DGENCD DELETE CATASTROPHIC DISABILITY protocol
+1 ; Input -- DFN Patient IEN
+2 ; Output -- VALMBCK R =Refresh screen
+3 NEW DGCDIS
+4 SET VALMBCK=""
+5 DO FULL^VALM1
+6 IF $$GET^DGENCDA(DFN,.DGCDIS)
IF '$DATA(DGCDIS("DESCR"))
Begin DoDot:1
+7 WRITE !!,">>> No Catastrophic Disabilities exist for this veteran.<<<"
+8 WRITE !!,"VETERAN IS NOT CATASTROPHICALLY DISABLED"
+9 SET DIR(0)="EA"
SET DIR("A")="Press return to continue..."
DO ^DIR
+10 SET DGCDIS("VCD")="N"
+11 ; DG*5.3*894
NEW I
FOR I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT"
SET DGCDIS(I)=""
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 IF $$RUSURE(DFN)
Begin DoDot:2
+14 SET DGCDIS("VCD")="N"
+15 NEW I,ERROR
+16 ; DG*5.3*894
FOR I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT"
SET DGCDIS(I)=""
+17 FOR I=1:1
if '$DATA(DGCDIS("DESCR",I))
QUIT
KILL DGCDIS("DESCR",I)
+18 IF $$STORE^DGENCDA2(DFN,.DGCDIS,.ERROR)
End DoDot:2
End DoDot:1
+19 DO INIT^DGENLCD
+20 SET VALMBCK="R"
+21 QUIT
+22 ;
RUSURE(DFN) ;
+1 ;Description: Asks user 'Are you sure?'
+2 ;Input: DFN is the patient ien
+3 ;Output: Function Value returns 0 or 1
+4 ;
+5 NEW DIR,SITE,SITEINF,DIROUT,DIRUT,DTOUT,DUOUT,NOERR
+6 SET SITE=$$CHKSITE^DGENCDA(DFN)
+7 ;CD was not determined at this site
IF '$PIECE(SITE,"^")
Begin DoDot:1
+8 SET SITEINF=$$NS^XUAF4($PIECE(SITE,"^",2))
+9 DO BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$PIECE(SITEINF,"^",2))
+10 DO MES^XPDUTL("Please Contact Site "_$PIECE(SITEINF,"^"))
+11 DO MES^XPDUTL("if it is necessary to delete this evaluation.")
+12 SET DIR(0)="EA"
SET DIR("A")="Press return to continue..."
DO ^DIR
End DoDot:1
QUIT 0
+13 ; was this entered in error?
+14 IF $$CDTYPE^DGENCDA(DFN)
Begin DoDot:1
+15 DO BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you")
+16 DO MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.")
+17 SET DIR(0)="Y"
SET DIR("B")="NO"
+18 SET DIR("A")="Is this deletion due to an error in data entry"
+19 DO ^DIR
+20 IF $GET(DIRUT)!$GET(DUOUT)!$GET(DIROUT)!$GET(DTOUT)!('$GET(Y))
SET NOERR=1
+21 KILL DIR,Y
End DoDot:1
if $GET(NOERR)
QUIT 0
+22 ;
+23 SET DIR(0)="Y"
+24 SET DIR("A")="Are you sure that the Catastrophic Disability should be deleted"
+25 SET DIR("B")="NO"
+26 IF $$HASCAT^DGENCDA(DFN)
Begin DoDot:1
+27 WRITE !!,">>> Deleting the Catastrophic Disability information will <<<",!
+28 WRITE ">>> also delete all supporting fields, including Descriptors. <<<",!
End DoDot:1
+29 DO ^DIR
+30 if $DATA(DIRUT)
QUIT 0
+31 QUIT Y
+32 ;
YN(PROMPT,DFLT) ; Ask user a yes/no question.
+1 SET DFLT=$EXTRACT($GET(DFLT,"N"))
+2 NEW YN,%,%Y
+3 FOR
Begin DoDot:1
+4 WRITE PROMPT
+5 SET %=$SELECT(DFLT="N":2,DFLT="Y":1,1:0)
+6 DO YN^DICN
+7 WRITE !
+8 SET YN=$SELECT(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
+9 IF YN["?"
WRITE ?5,"You can just enter 'Y' or 'N'.",!!
End DoDot:1
if "YN^"[YN
QUIT
+10 QUIT YN
