Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENCD1

DGENCD1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EN(DFN) ;Entry point for DGENCD CATASTROPHIC DISABILITY protocol
  1.  D EN^DGENLCD(DFN)
  1.  D:DFN BLD^DGENL
  1.  Q
  1.  ;
  1. ADDCD ;Entry point for DGENCD ADD/EDIT CATASTROPHIC DISABILITY protocol 
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- VALMBCK  R   =Refresh screen
  1.  N YN,EXIT,PRI,CDSITE
  1.  S VALMBCK="",EXIT=0
  1.  D FULL^VALM1
  1.  I $$CDTYPE^DGENCDA(DFN) D  ;was determination by physical exam?
  1.  .S CDSITE=$$CHKSITE^DGENCDA(DFN)
  1.  .I CDSITE D  ;CD was determined by this site
  1.  ..D BMES^XPDUTL("This veteran is currently determined to be Catastrophically")
  1.  ..D MES^XPDUTL("Disabled.  You may not change this evaluation unless it is due")
  1.  ..D MES^XPDUTL("to an error in data entry.")
  1.  ..S YN=$$YN("Is this edit due to an error in data entry")
  1.  ..D:"N^"[$E($G(YN))
  1.  ...D BMES^XPDUTL("Additional CD evaluations are not necessary for this")
  1.  ...D MES^XPDUTL("Veteran, as they are currently determined to be CD.  If")
  1.  ...D MES^XPDUTL("this is an edit due to an error, please return to the")
  1.  ...D MES^XPDUTL("Add/Edit action and answer YES to this prompt.")
  1.  ...S EXIT=1
  1.  .E  D  ;  CD was determined by another site
  1.  ..S SITEINF=$$NS^XUAF4($P(CDSITE,"^",2))
  1.  ..D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
  1.  ..D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
  1.  ..D MES^XPDUTL("if it is necessary to edit this evaluation.")
  1.  ..S EXIT=1
  1.  ..S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
  1.  I EXIT S VALMBCK="R" Q
  1.  ;
  1.  S PRI=$$PRIORITY^DGENA(DFN)
  1.  I PRI,PRI'>4 D
  1.  . W:$X !
  1.  . W !,"According to the veteran's current enrollment record, the",!
  1.  . W "assignment of a Catastrophically Disabled Status will not",!
  1.  . W "improve his/her enrollment priority.",!!
  1.  . S YN=$$YN("Do you still want to perform a review")
  1.  . I "N^"[$E($G(YN)) S EXIT=1
  1.  I 'EXIT D EDITCD^DGENCD(DFN),INIT^DGENLCD
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. DELETECD ;Entry point for DGENCD DELETE CATASTROPHIC DISABILITY protocol 
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- VALMBCK  R   =Refresh screen
  1.  S VALMBCK=""
  1.  D FULL^VALM1
  1.  I $$GET^DGENCDA(DFN,.DGCD),'$D(DGCD("DIAG")) D
  1.  .W !!,">>>No Catastrophic Disabilities exist for this veteran.<<<"
  1.  .S DIR(0)="EA",DIR("A")="Press return to continue..." D ^DIR
  1.  E  D
  1.  .I $$RUSURE(DFN) D
  1.  ..I $$DELETE^DGENCDA1(DFN)
  1.  D INIT^DGENLCD
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. RUSURE(DFN) ;
  1.  ;Description: Asks user 'Are you sure?'
  1.  ;Input: DFN is the patient ien
  1.  ;Output: Function Value returns 0 or 1
  1.  ;
  1.  N DIR,SITE,SITEINF,DIROUT,DIRUT,DTOUT,DUOUT,NOERR
  1.  S SITE=$$CHKSITE^DGENCDA(DFN)
  1.  I '$P(SITE,"^") D  Q 0   ;CD was not determined at this site
  1.  .S SITEINF=$$NS^XUAF4($P(SITE,"^",2))
  1.  .D BMES^XPDUTL("This Catastrophic Disability evaluation was entered at Site:"_$P(SITEINF,"^",2))
  1.  .D MES^XPDUTL("Please Contact Site "_$P(SITEINF,"^"))
  1.  .D MES^XPDUTL("if it is necessary to delete this evaluation.")
  1.  ; was this entered in error?
  1.  I $$CDTYPE^DGENCDA(DFN) D  Q:$G(NOERR) 0
  1.  .D BMES^XPDUTL("This Veteran is currently determined to be Catastrophically Disabled, you")
  1.  .D MES^XPDUTL("may not delete this evaluation unless it is due to an error in data entry.")
  1.  .S DIR(0)="Y",DIR("B")="NO"
  1.  .S DIR("A")="Is this deletion due to an error in data entry"
  1.  .D ^DIR
  1.  .I $G(DIRUT)!$G(DUOUT)!$G(DIROUT)!$G(DTOUT)!('$G(Y)) S NOERR=1
  1.  .K DIR,Y
  1.  ;
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Are you sure that the Catastrophic Disability should be deleted"
  1.  S DIR("B")="NO"
  1.  I $$HASCAT^DGENCDA(DFN) D
  1.  . W !!,">>> Deleting the Catastrophic Disability information will also delete all <<<",!
  1.  . W ">>>  supporting fields, including Diagnoses, Procedures and Conditions.   <<<",!
  1.  D ^DIR
  1.  Q:$D(DIRUT) 0
  1.  Q Y
  1.  ;
  1. YN(PROMPT,DFLT) ; Ask user a yes/no question.
  1.  S DFLT=$E($G(DFLT,"N"))
  1.  N YN,%,%Y
  1.  F  D  Q:"YN^"[YN
  1.  . W PROMPT
  1.  . S %=$S(DFLT="N":2,DFLT="Y":1,1:0)
  1.  . D YN^DICN
  1.  . W !
  1.  . S YN=$S(%=-1:"^",%=1:"Y",%=2:"N",1:"?")
  1.  . I YN["?" W ?5,"You can just enter 'Y' or 'N'.",!!
  1.  Q YN