DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM - Catastrophic Disability Protocols; 02/17/2005
;;5.3;Registration;**121,232,387,451,610,1015**;Aug 13,1993;Build 21
;
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
S VALMBCK=""
D FULL^VALM1
I $$GET^DGENCDA(DFN,.DGCD),'$D(DGCD("DIAG")) D
.W !!,">>>No Catastrophic Disabilities exist for this veteran.<<<"
.S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
E D
.I $$RUSURE(DFN) D
..I $$DELETE^DGENCDA1(DFN)
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.")
; 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 also delete all <<<",!
. W ">>> supporting fields, including Diagnoses, Procedures and Conditions. <<<",!
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
DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM - Catastrophic Disability Protocols; 02/17/2005
+1 ;;5.3;Registration;**121,232,387,451,610,1015**;Aug 13,1993;Build 21
+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 SET VALMBCK=""
+4 DO FULL^VALM1
+5 IF $$GET^DGENCDA(DFN,.DGCD)
IF '$DATA(DGCD("DIAG"))
Begin DoDot:1
+6 WRITE !!,">>>No Catastrophic Disabilities exist for this veteran.<<<"
+7 SET DIR(0)="EA"
SET DIR("A")="Press return to continue..."
DO ^DIR
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 IF $$RUSURE(DFN)
Begin DoDot:2
+10 IF $$DELETE^DGENCDA1(DFN)
End DoDot:2
End DoDot:1
+11 DO INIT^DGENLCD
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
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.")
End DoDot:1
QUIT 0
+12 ; was this entered in error?
+13 IF $$CDTYPE^DGENCDA(DFN)
Begin DoDot:1
+14 DO BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you")
+15 DO MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.")
+16 SET DIR(0)="Y"
SET DIR("B")="NO"
+17 SET DIR("A")="Is this deletion due to an error in data entry"
+18 DO ^DIR
+19 IF $GET(DIRUT)!$GET(DUOUT)!$GET(DIROUT)!$GET(DTOUT)!('$GET(Y))
SET NOERR=1
+20 KILL DIR,Y
End DoDot:1
IF $GET(NOERR)
QUIT 0
+21 ;
+22 SET DIR(0)="Y"
+23 SET DIR("A")="Are you sure that the Catastrophic Disability should be deleted"
+24 SET DIR("B")="NO"
+25 IF $$HASCAT^DGENCDA(DFN)
Begin DoDot:1
+26 WRITE !!,">>> Deleting the Catastrophic Disability information will also delete all <<<",!
+27 WRITE ">>> supporting fields, including Diagnoses, Procedures and Conditions. <<<",!
End DoDot:1
+28 DO ^DIR
+29 IF $DATA(DIRUT)
QUIT 0
+30 QUIT Y
+31 ;
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
