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

DGENLCD1.m

Go to the documentation of this file. 
  1. DGENLCD1 ;ALB/CJM,Zoltan,JAN - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997 08:00 am,NOV 14 2001
  1.  ;;5.3;Registration;**121,232,387,1015**;Aug 13,1993;Build 21
  1.  ;
  1. EN(DGARY,DFN,DGCNT) ;Entry point to build list area
  1.  ; Input  -- DGARY    Global array subscript
  1.  ;           DFN      Patient IEN
  1.  ; Output -- DGCNT    Number of lines in the list
  1.  N DGCDIS,DGLINE
  1.  I $$GET^DGENCDA(DFN,.DGCDIS) ;set-up catastrophic disability array
  1.  S DGLINE=1,DGCNT=0
  1.  D CD(DGARY,DFN,.DGCDIS,.DGLINE,.DGCNT)
  1.  Q
  1.  ;
  1. CD(DGARY,DFN,DGCDIS,DGLINE,DGCNT) ;
  1.  ;Description: Writes Catastrophic Disabilty info to list.
  1.  ; Input  -- DGARY    Global array subscript
  1.  ;           DFN      Patient IEN
  1.  ;           DGCDIS    Enrollment array
  1.  ;           DGLINE   Line number
  1.  ; Output -- DGCNT    Number of lines in the list
  1.  N DGSTART,HASCAT,PERM
  1.  ;
  1.  S DGSTART=DGLINE ; starting line number
  1.  D SET^DGENL1(DGARY,DGLINE," Catastrophic Disability ",28,IORVON,IORVOFF,,,,.DGCNT)
  1.  S DGLINE=DGLINE+2
  1.  S HASCAT=$$HASCAT^DGENCDA(DFN)
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Veteran Catastrophically Disabled:   ",41)_$S(HASCAT:"YES",1:"NO"),1,,,,,,.DGCNT)
  1.  ;
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Date of Decision:   ",41)_$$EXT^DGENCDU("DATE",DGCDIS("DATE")),1,,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Decided By:   ",41)_$$EXT^DGENCDU("BY",DGCDIS("BY")),1,,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Facility Making Determination:   ",41)_$$EXT^DGENCDU("FACDET",DGCDIS("FACDET")),1,,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Review Date:   ",41)_$$EXT^DGENCDU("REVDTE",DGCDIS("REVDTE")),1,,,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGENL1(DGARY,DGLINE,$J("Method of Determination:   ",41)_$$EXT^DGENCDU("METDET",DGCDIS("METDET")),1,,,,,,.DGCNT)
  1.  ;
  1.  ; Display reasons for CD Determination.
  1.  I '$D(DGCDIS("DIAG")),'$D(DGCDIS("PROC")),'$D(DGCDIS("COND")) Q
  1.  S DGLINE=DGLINE+2
  1.  D SET^DGENL1(DGARY,DGLINE," Reason(s) for CD Determination ",24,IORVON,IORVOFF,,,,.DGCNT)
  1.  S DGLINE=DGLINE+1
  1.  S (ITEM,SUBITEM)=""
  1.  F  S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:ITEM=""  D
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Diagnosis:   ",25)_$$EXT^DGENCDU("DIAG",DGCDIS("DIAG",ITEM)),1,,,,,,.DGCNT)
  1.  F  S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM=""  D
  1.  . F  S SUBITEM=$O(DGCDIS("EXT",ITEM,SUBITEM)) Q:SUBITEM=""  D
  1.  . . S DGLINE=DGLINE+1
  1.  . . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Procedure:   ",25)_$$EXT^DGENCDU("PROC",DGCDIS("PROC",ITEM)),1,,,,,,.DGCNT)
  1.  . . S DGLINE=DGLINE+1
  1.  . . D SET^DGENL1(DGARY,DGLINE,$J("Affected Extremity:   ",30)_$$EXT^DGENCDU("EXT",DGCDIS("EXT",ITEM,SUBITEM)),1,,,,,,.DGCNT)
  1.  F  S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM=""  D
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Condition:   ",25)_$$EXT^DGENCDU("COND",DGCDIS("COND",ITEM)),1,,,,,,.DGCNT)
  1.  . S DGLINE=DGLINE+1
  1.  . D SET^DGENL1(DGARY,DGLINE,$J("Score:   ",30)_$$EXT^DGENCDU("SCORE",DGCDIS("SCORE",ITEM)),1,,,,,,.DGCNT)
  1.  . S DGLINE=DGLINE+1
  1.  . I '$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM),1) S PERM="N/A"
  1.  . E  S PERM=$$EXT^DGENCDU("PERM",DGCDIS("PERM",ITEM))
  1.  . D SET^DGENL1(DGARY,DGLINE,$J("Permanent Indicator:   ",30)_PERM,1,,,,,,.DGCNT)
  1.  ;
  1.  Q