| 1 | DGENCD1 ;ALB/CJM,Zoltan,PHH,BRM - Catastrophic Disability Protocols; 02/17/2005
|
|---|
| 2 | ;;5.3;Registration;**121,232,387,451,610**;Aug 13,1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN(DFN) ;Entry point for DGENCD CATASTROPHIC DISABILITY protocol
|
|---|
| 5 | D EN^DGENLCD(DFN)
|
|---|
| 6 | D:DFN BLD^DGENL
|
|---|
| 7 | Q
|
|---|
| 8 | ;
|
|---|
| 9 | ADDCD ;Entry point for DGENCD ADD/EDIT CATASTROPHIC DISABILITY protocol
|
|---|
| 10 | ; Input -- DFN Patient IEN
|
|---|
| 11 | ; Output -- VALMBCK R =Refresh screen
|
|---|
| 12 | N YN,EXIT,PRI,CDSITE
|
|---|
| 13 | S VALMBCK="",EXIT=0
|
|---|
| 14 | D FULL^VALM1
|
|---|
| 15 | I $$CDTYPE^DGENCDA(DFN) D ;was determination by physical exam?
|
|---|
| 16 | .S CDSITE=$$CHKSITE^DGENCDA(DFN)
|
|---|
| 17 | .I CDSITE D ;CD was determined by this site
|
|---|
| 18 | ..D BMES^XPDUTL("This veteran is currently determined to be Catastrophically")
|
|---|
| 19 | ..D MES^XPDUTL("Disabled. You may not change this evaluation unless it is due")
|
|---|
| 20 | ..D MES^XPDUTL("to an error in data entry.")
|
|---|
| 21 | ..S YN=$$YN("Is this edit due to an error in data entry")
|
|---|
| 22 | ..D:"N^"[$E($G(YN))
|
|---|
| 23 | ...D BMES^XPDUTL("Additional CD evaluations are not necessary for this")
|
|---|
| 24 | ...D MES^XPDUTL("Veteran, as they are currently determined to be CD. If")
|
|---|
| 25 | ...D MES^XPDUTL("this is an edit due to an error, please return to the")
|
|---|
| 26 | ...D MES^XPDUTL("Add/Edit action and answer YES to this prompt.")
|
|---|
| 27 | ...S EXIT=1
|
|---|
| 28 | .E D ; CD was determined by another site
|
|---|
| 29 | ..S SITEINF=$$NS^XUAF4($P(CDSITE,"^",2))
|
|---|
| 30 | ..D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
|
|---|
| 31 | ..D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
|
|---|
| 32 | ..D MES^XPDUTL("if it is necessary to edit this evaluation.")
|
|---|
| 33 | ..S EXIT=1
|
|---|
| 34 | ..S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
|
|---|
| 35 | I EXIT S VALMBCK="R" Q
|
|---|
| 36 | ;
|
|---|
| 37 | S PRI=$$PRIORITY^DGENA(DFN)
|
|---|
| 38 | I PRI,PRI'>4 D
|
|---|
| 39 | . W:$X !
|
|---|
| 40 | . W !,"According to the veteran's current enrollment record, the",!
|
|---|
| 41 | . W "assignment of a Catastrophically Disabled Status will not",!
|
|---|
| 42 | . W "improve his/her enrollment priority.",!!
|
|---|
| 43 | . S YN=$$YN("Do you still want to perform a review")
|
|---|
| 44 | . I "N^"[$E($G(YN)) S EXIT=1
|
|---|
| 45 | I 'EXIT D EDITCD^DGENCD(DFN),INIT^DGENLCD
|
|---|
| 46 | S VALMBCK="R"
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | DELETECD ;Entry point for DGENCD DELETE CATASTROPHIC DISABILITY protocol
|
|---|
| 50 | ; Input -- DFN Patient IEN
|
|---|
| 51 | ; Output -- VALMBCK R =Refresh screen
|
|---|
| 52 | S VALMBCK=""
|
|---|
| 53 | D FULL^VALM1
|
|---|
| 54 | I $$GET^DGENCDA(DFN,.DGCD),'$D(DGCD("DIAG")) D
|
|---|
| 55 | .W !!,">>>No Catastrophic Disabilities exist for this veteran.<<<"
|
|---|
| 56 | .S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
|
|---|
| 57 | E D
|
|---|
| 58 | .I $$RUSURE(DFN) D
|
|---|
| 59 | ..I $$DELETE^DGENCDA1(DFN)
|
|---|
| 60 | D INIT^DGENLCD
|
|---|
| 61 | S VALMBCK="R"
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | RUSURE(DFN) ;
|
|---|
| 65 | ;Description: Asks user 'Are you sure?'
|
|---|
| 66 | ;Input: DFN is the patient ien
|
|---|
| 67 | ;Output: Function Value returns 0 or 1
|
|---|
| 68 | ;
|
|---|
| 69 | N DIR,SITE,SITEINF,DIROUT,DIRUT,DTOUT,DUOUT,NOERR
|
|---|
| 70 | S SITE=$$CHKSITE^DGENCDA(DFN)
|
|---|
| 71 | I '$P(SITE,"^") D Q 0 ;CD was not determined at this site
|
|---|
| 72 | .S SITEINF=$$NS^XUAF4($P(SITE,"^",2))
|
|---|
| 73 | .D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
|
|---|
| 74 | .D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
|
|---|
| 75 | .D MES^XPDUTL("if it is necessary to delete this evaluation.")
|
|---|
| 76 | ; was this entered in error?
|
|---|
| 77 | I $$CDTYPE^DGENCDA(DFN) D Q:$G(NOERR) 0
|
|---|
| 78 | .D BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you")
|
|---|
| 79 | .D MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.")
|
|---|
| 80 | .S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 81 | .S DIR("A")="Is this deletion due to an error in data entry"
|
|---|
| 82 | .D ^DIR
|
|---|
| 83 | .I $G(DIRUT)!$G(DUOUT)!$G(DIROUT)!$G(DTOUT)!('$G(Y)) S NOERR=1
|
|---|
| 84 | .K DIR,Y
|
|---|
| 85 | ;
|
|---|
| 86 | S DIR(0)="Y"
|
|---|
| 87 | S DIR("A")="Are you sure that the Catastrophic Disability should be deleted"
|
|---|
| 88 | S DIR("B")="NO"
|
|---|
| 89 | I $$HASCAT^DGENCDA(DFN) D
|
|---|
| 90 | . W !!,">>> Deleting the Catastrophic Disability information will also delete all <<<",!
|
|---|
| 91 | . W ">>> supporting fields, including Diagnoses, Procedures and Conditions. <<<",!
|
|---|
| 92 | D ^DIR
|
|---|
| 93 | Q:$D(DIRUT) 0
|
|---|
| 94 | Q Y
|
|---|
| 95 | ;
|
|---|
| 96 | YN(PROMPT,DFLT) ; Ask user a yes/no question.
|
|---|
| 97 | S DFLT=$E($G(DFLT,"N"))
|
|---|
| 98 | N YN,%,%Y
|
|---|
| 99 | F D Q:"YN^"[YN
|
|---|
| 100 | . W PROMPT
|
|---|
| 101 | . S %=$S(DFLT="N":2,DFLT="Y":1,1:0)
|
|---|
| 102 | . D YN^DICN
|
|---|
| 103 | . W !
|
|---|
| 104 | . S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
|
|---|
| 105 | . I YN["?" W ?5,"You can just enter 'Y' or 'N'.",!!
|
|---|
| 106 | Q YN
|
|---|
