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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM - Catastrophic Disability API - Retrieve Data;May 24, 1999;Nov 14, 2001 ; 9/19/05 11:35am
2 ;;5.3;Registration;**121,147,232,387,451,653**;Aug 13,1993;Build 2
3 ;
4GET(DFN,DGCDIS) ;
5 ;Description: Get catastrophic disability information for a patient
6 ;Input:
7 ; DFN - Patient IEN
8 ;Output:
9 ; DGCDIS - the catastrophic disability array, passed by reference
10 ; subscripts:
11 ; "BY" Decided By
12 ; "DATE" Date of Decision
13 ; "FACDET" Facility Making Determination
14 ; "REVDTE" Review Date
15 ; "VETREQDT" Date Veteran Requested CD Evaluation
16 ; "DTFACIRV" Date Facility Initiated Review
17 ; "DTVETNOT" Date Veteran Was Notified
18 ;
19 N SUB,ITEM,SITEM,SIEN,IND
20 K DGCDIS S DGCDIS=""
21 I '$G(DFN) D Q 0
22 . F SUB="VCD","BY","DATE","FACDET","REVDTE","METDET","VETREQDT","DTFACIRV","DTVETNOT" S DGCDIS(SUB)=""
23 ; .39 VETERAN CATASTROPHICALLY DISABLED? field.
24 S DGCDIS("VCD")=$P($G(^DPT(DFN,.39)),"^",6)
25 ; .391 DECIDED BY field.
26 S DGCDIS("BY")=$P($G(^DPT(DFN,.39)),"^",1)
27 ; .392 DATE OF DECISION field.
28 S DGCDIS("DATE")=$P($G(^DPT(DFN,.39)),"^",2)
29 ; .393 FACILITY MAKING DETERMINATION field.
30 S DGCDIS("FACDET")=$P($G(^DPT(DFN,.39)),"^",3)
31 ; .394 REVIEW DATE field.
32 S DGCDIS("REVDTE")=$P($G(^DPT(DFN,.39)),"^",4)
33 ; .395 METHOD OF DETERMINATION field.
34 S DGCDIS("METDET")=$P($G(^DPT(DFN,.39)),"^",5)
35 ; .3951 DATE VETERAN REQUESTED CD EVAL
36 S DGCDIS("VETREQDT")=$P($G(^DPT(DFN,.39)),"^",7)
37 ; .3952 DATE FACILITY INITIATED REVIEW
38 S DGCDIS("DTFACIRV")=$P($G(^DPT(DFN,.39)),"^",8)
39 ; .3953 DATE VETERAN WAS NOTIFIED
40 S DGCDIS("DTVETNOT")=$P($G(^DPT(DFN,.39)),"^",9)
41 ; .396 CD STATUS DIAGNOSES field (multiple):
42 S SIEN=0
43 F ITEM=1:1 S SIEN=$O(^DPT(DFN,.396,SIEN)) Q:'SIEN D
44 . ; .01 CD STATUS DIAGNOSES sub-field.
45 . S DGCDIS("DIAG",ITEM)=$P($G(^DPT(DFN,.396,SIEN,0)),"^",1)
46 ; .397 CD STATUS PROCEDURES field (multiple):
47 S (ITEM,SITEM,SIEN)=0
48 F S ITEM=$O(^DPT(DFN,.397,"B",ITEM)) Q:'ITEM D
49 . S IND=0,SIEN=SIEN+1
50 . F S SITEM=$O(^DPT(DFN,.397,"B",ITEM,SITEM)) Q:'SITEM D
51 . . ; .01 CD STATUS PROCEDURES sub-field.
52 . . S DGCDIS("PROC",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",1)
53 . . ; 1 AFFECTED EXTREMITY sub-field.
54 . . S DGCDIS("EXT",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2)
55 . . S IND=IND+1,DGCDIS("EXT",SIEN,IND)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2)
56 ; - .398 CD STATUS CONDITIONS field (multiple):
57 S SIEN=0
58 F ITEM=1:1 S SIEN=$O(^DPT(DFN,.398,SIEN)) Q:'SIEN D
59 . ; .01 CD STATUS CONDITIONS sub-field.
60 . S DGCDIS("COND",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",1)
61 . ; 1 SCORE sub-field.
62 . S DGCDIS("SCORE",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",2)
63 . ; 2 PERMANENT INDICATOR sub-field.
64 . S DGCDIS("PERM",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",3)
65 Q 1
66 ;
67DISABLED(DFN) ;
68 ;Description: Returns whether the patient is catastrophically disabled.
69 ;
70 ;Input:
71 ; DFN - Patient IEN
72 ;Output:
73 ; Function Value - returns 1 if the patient is catastrophically
74 ; disabled, otherwise 0
75 ;
76 Q $$HASCAT(DFN)
77 ;
78HASCAT(DFN) ;
79 ;Description: returns 1 if the patient is CATASTROPHICALLY DISABLED
80 ;
81 Q:'$G(DFN) 0
82 Q $P($G(^DPT(DFN,.39)),"^",6)="Y"
83 ;
84CHKSITE(DFN) ;is this the facility that made the CD determination?
85 ;
86 ;Input:
87 ; DFN - Patient IEN
88 ;Output:
89 ; Function Value - returns 1 if CD evaluation was entered at local
90 ; site, otherwise 0^SITE #
91 ;
92 Q:'$G(DFN) 0
93 N SITE
94 S SITE=$$SITE^VASITE
95 Q:$P($G(^DPT(DFN,.39)),"^",3)=$P(SITE,"^") 1
96 Q "0^"_$P($G(^DPT(DFN,.39)),"^",3)
97 ;
98CDTYPE(DFN) ; Was the method of determination "Physical Exam"?
99 ;
100 ;Input:
101 ; DFN - Patient IEN
102 ;Output:
103 ; Function Value - returns 1 if CD='Yes' & Method='Physical Exam'
104 ; otherwise 0
105 ;
106 Q:'$G(DFN) 0
107 Q:'$$HASCAT(DFN) 0
108 Q $P($G(^DPT(DFN,.39)),"^",5)=3
109 ;
Note: See TracBrowser for help on using the repository browser.