source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENLCD1.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1DGENLCD1 ;ALB/CJM,Zoltan,JAN - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997 08:00 am,NOV 14 2001
2 ;;5.3;Registration;**121,232,387**;Aug 13,1993
3 ;
4EN(DGARY,DFN,DGCNT) ;Entry point to build list area
5 ; Input -- DGARY Global array subscript
6 ; DFN Patient IEN
7 ; Output -- DGCNT Number of lines in the list
8 N DGCDIS,DGLINE
9 I $$GET^DGENCDA(DFN,.DGCDIS) ;set-up catastrophic disability array
10 S DGLINE=1,DGCNT=0
11 D CD(DGARY,DFN,.DGCDIS,.DGLINE,.DGCNT)
12 Q
13 ;
14CD(DGARY,DFN,DGCDIS,DGLINE,DGCNT) ;
15 ;Description: Writes Catastrophic Disabilty info to list.
16 ; Input -- DGARY Global array subscript
17 ; DFN Patient IEN
18 ; DGCDIS Enrollment array
19 ; DGLINE Line number
20 ; Output -- DGCNT Number of lines in the list
21 N DGSTART,HASCAT,PERM
22 ;
23 S DGSTART=DGLINE ; starting line number
24 D SET^DGENL1(DGARY,DGLINE," Catastrophic Disability ",28,IORVON,IORVOFF,,,,.DGCNT)
25 S DGLINE=DGLINE+2
26 S HASCAT=$$HASCAT^DGENCDA(DFN)
27 D SET^DGENL1(DGARY,DGLINE,$J("Veteran Catastrophically Disabled: ",41)_$S(HASCAT:"YES",1:"NO"),1,,,,,,.DGCNT)
28 ;
29 S DGLINE=DGLINE+1
30 D SET^DGENL1(DGARY,DGLINE,$J("Date of Decision: ",41)_$$EXT^DGENCDU("DATE",DGCDIS("DATE")),1,,,,,,.DGCNT)
31 S DGLINE=DGLINE+1
32 D SET^DGENL1(DGARY,DGLINE,$J("Decided By: ",41)_$$EXT^DGENCDU("BY",DGCDIS("BY")),1,,,,,,.DGCNT)
33 S DGLINE=DGLINE+1
34 D SET^DGENL1(DGARY,DGLINE,$J("Facility Making Determination: ",41)_$$EXT^DGENCDU("FACDET",DGCDIS("FACDET")),1,,,,,,.DGCNT)
35 S DGLINE=DGLINE+1
36 D SET^DGENL1(DGARY,DGLINE,$J("Review Date: ",41)_$$EXT^DGENCDU("REVDTE",DGCDIS("REVDTE")),1,,,,,,.DGCNT)
37 S DGLINE=DGLINE+1
38 D SET^DGENL1(DGARY,DGLINE,$J("Method of Determination: ",41)_$$EXT^DGENCDU("METDET",DGCDIS("METDET")),1,,,,,,.DGCNT)
39 ;
40 ; Display reasons for CD Determination.
41 I '$D(DGCDIS("DIAG")),'$D(DGCDIS("PROC")),'$D(DGCDIS("COND")) Q
42 S DGLINE=DGLINE+2
43 D SET^DGENL1(DGARY,DGLINE," Reason(s) for CD Determination ",24,IORVON,IORVOFF,,,,.DGCNT)
44 S DGLINE=DGLINE+1
45 S (ITEM,SUBITEM)=""
46 F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:ITEM="" D
47 . S DGLINE=DGLINE+1
48 . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Diagnosis: ",25)_$$EXT^DGENCDU("DIAG",DGCDIS("DIAG",ITEM)),1,,,,,,.DGCNT)
49 F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D
50 . F S SUBITEM=$O(DGCDIS("EXT",ITEM,SUBITEM)) Q:SUBITEM="" D
51 . . S DGLINE=DGLINE+1
52 . . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Procedure: ",25)_$$EXT^DGENCDU("PROC",DGCDIS("PROC",ITEM)),1,,,,,,.DGCNT)
53 . . S DGLINE=DGLINE+1
54 . . D SET^DGENL1(DGARY,DGLINE,$J("Affected Extremity: ",30)_$$EXT^DGENCDU("EXT",DGCDIS("EXT",ITEM,SUBITEM)),1,,,,,,.DGCNT)
55 F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D
56 . S DGLINE=DGLINE+1
57 . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Condition: ",25)_$$EXT^DGENCDU("COND",DGCDIS("COND",ITEM)),1,,,,,,.DGCNT)
58 . S DGLINE=DGLINE+1
59 . D SET^DGENL1(DGARY,DGLINE,$J("Score: ",30)_$$EXT^DGENCDU("SCORE",DGCDIS("SCORE",ITEM)),1,,,,,,.DGCNT)
60 . S DGLINE=DGLINE+1
61 . I '$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM),1) S PERM="N/A"
62 . E S PERM=$$EXT^DGENCDU("PERM",DGCDIS("PERM",ITEM))
63 . D SET^DGENL1(DGARY,DGLINE,$J("Permanent Indicator: ",30)_PERM,1,,,,,,.DGCNT)
64 ;
65 Q
Note: See TracBrowser for help on using the repository browser.