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

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

initial load of WorldVistAEHR
File size: 7.3 KB
Line 
1DGENCDA1 ;ALB/CJM,RMM Zoltan,JAN,PHH,BRM,CKN - Catastrophic Disabilty API - File Data;Sep 16, 2002 ; 9/22/05 5:25pm
2 ;;5.3;Registration;**121,147,232,302,356,387,475,451,653**;Aug 13,1993;Build 2
3 ;
4LOCK(DFN) ;
5 ;Description: Locks the catastrophic disability record for a patient
6 ;Input:
7 ; DFN - Patient IEN
8 ;Output:
9 ; Function Value - returns 1 if the patient is catastrophic disability
10 ; record can be locked, otherwise 0
11 I $G(DFN) L +^DPT(DFN,.39):2
12 Q $T
13 ;
14UNLOCK(DFN) ;
15 ;Description: Unlocks the catastrophic disability record for a patient
16 ;Input:
17 ; DFN - Patient IEN
18 ;Output:
19 ; None
20 I $G(DFN) L -^DPT(DFN,.39)
21 Q
22 ;
23CHECK(DGCDIS,ERROR) ;
24 ;Description: Validity checks on the catastrophic disability contained
25 ; in the DGCDIS array
26 ;Input:
27 ; DGCDIS - the catastrophic disability array, passed by reference
28 ;Output:
29 ; Function Value - returns 1 if validation checks passed, 0 otherwise
30 ; ERROR - if validation fails an error mssg is returned, pass by
31 ; reference
32 N VALID,RESULT,EXTERNAL,ITEM,EIEN,EXIT,OK,ISCD,POP,FLD
33 S ERROR=""
34 Q:DGCDIS("VCD")="@" 1 ;this is a deletion
35 D ;drops out of block if invalid condition found
36 . S VALID=0 ; Usually invalid if it exits early.
37 . ; CD Flag must have a value if any other CD field is populated
38 . S POP=0
39 . I DGCDIS("VCD")="" D Q:POP
40 . . F FLD="BY","DATE","FACDET","REVDTE","METDET" D Q:POP
41 . . . I $G(DGCDIS(FLD))]"" S POP=1
42 . . I POP S ERROR="'VETERAN CATASTROPHICALLY DISABLED?' FIELD MUST HAVE A RESPONSE" Q
43 . . I $G(DGCDIS("DIAG",1))]""!($G(DGCDIS("COND",1))]"")!($G(DGCDIS("PROC",1))]"") D
44 . . . S POP=1,ERROR="'VETERAN CATASTROPHICALLY DISABLED?' FIELD MUST HAVE A RESPONSE" Q
45 . ; Decided by.
46 . I DGCDIS("VCD")'="",$G(DGCDIS("BY"))="" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' REQUIRED" Q
47 . I $G(DGCDIS("BY"))'="",($L(DGCDIS("BY"))<3)!($L(DGCDIS("BY"))>35) S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' NOT VALID" Q
48 . I $$UPPER^DGUTL($G(DGCDIS("BY")))="HINQ" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' CAN NOT BE 'HINQ'" Q
49 . ; Date of Decision
50 . S OK=1,EXTERNAL=""
51 . I DGCDIS("VCD")'="",$G(DGCDIS("DATE"))="" S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' REQUIRED" Q
52 . I $G(DGCDIS("DATE"))'="" D
53 . . I 'DGCDIS("DATE") S OK=0 Q
54 . . S EXTERNAL=$$EXTERNAL^DILFD(2,.392,"",DGCDIS("DATE"))
55 . . I EXTERNAL="" S OK=0
56 . . D CHK^DIE(2,.392,,EXTERNAL,.RESULT)
57 . . I RESULT="^" S OK=0
58 . I 'OK S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' NOT VALID" Q
59 . ; Facility Making Determination.
60 . I DGCDIS("VCD")'=""!(DGCDIS("FACDET")'=""),$$EXTERNAL^DILFD(2,.393,"",$G(DGCDIS("FACDET")))="" S ERROR="'FACILITY MAKING CATASTROPHIC DISABILITY DETERMINATION' NOT VALID" Q
61 . ; Review Date
62 . I DGCDIS("VCD")'="",$G(DGCDIS("REVDTE"))="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' REQUIRED" Q
63 . I DGCDIS("REVDTE")'="" D Q:ERROR'=""
64 . . S EXTERNAL=$$EXTERNAL^DILFD(2,.394,"",DGCDIS("REVDTE"))
65 . . I EXTERNAL="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' NOT VALID" Q
66 . . D CHK^DIE(2,.394,,EXTERNAL,.RESULT)
67 . . I RESULT="^" S ERROR="'CATASTROPHIC DISABILTY REVIEW DATE' INVALID" Q
68 . . I $G(DGCDIS("DATE")),DGCDIS("REVDTE")>DGCDIS("DATE") S ERROR="'CD REVIEW DATE' GREATER THAN 'CD DATE OF DETERMINATION'." Q
69 . ; Method of Determination
70 . I $G(DGCDIS("METDET"))="",DGCDIS("VCD")'="" S ERROR="'METHOD OF DETERMINATION' IS A REQUIRED VALUE." Q
71 . I "..2.3."'[("."_$G(DGCDIS("METDET"))_".") S ERROR="'METHOD OF DETERMINATION' NOT VALID" Q
72 . S ITEM="",EXIT=0
73 . ; Diagnoses
74 . F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:'ITEM Q:EXIT D
75 . . I DGCDIS("DIAG",ITEM)="" Q
76 . . I $$TYPE^DGENA5(DGCDIS("DIAG",ITEM))'="D" S EXIT=1,ERROR="'CD STATUS DIAGNOSES' NOT VALID"
77 . Q:EXIT
78 . ; Procedures
79 . F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:'ITEM Q:EXIT D
80 . . I DGCDIS("PROC",ITEM)="" Q
81 . . I $$TYPE^DGENA5(DGCDIS("PROC",ITEM))'="P" S EXIT=1,ERROR="'CD STATUS PROCEDURE' NOT VALID" Q
82 . . S EIEN="" F S EIEN=$O(DGCDIS("EXT",ITEM,EIEN)) Q:EIEN="" D
83 . . . I '$$LIMBOK^DGENA5(DGCDIS("PROC",ITEM),DGCDIS("EXT",ITEM,EIEN)) S EXIT=1,ERROR="'CD STATUS AFFECTED EXTREMITY' INVALID"
84 . Q:EXIT
85 . ; Conditions
86 . F S ITEM=$O(DGCDIS("COND",ITEM)) Q:'ITEM Q:EXIT D
87 . . I DGCDIS("COND",ITEM)="" Q
88 . . I $$TYPE^DGENA5(DGCDIS("COND",ITEM))'="C" S EXIT=1,ERROR="'' NOT VALID" Q
89 . . I '$$VALID^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM)) S EXIT=1,ERROR="'CD CONDITION SCORE' NOT VALID" Q
90 . . I ".1.2.3."'[("."_DGCDIS("PERM",ITEM)_".") S ERROR="'PERMANENT STATUS INDICATOR' NOT VALID" Q
91 . Q:EXIT
92 . ; No reason present?
93 . I DGCDIS("VCD")="Y",'($D(DGCDIS("DIAG"))!$D(DGCDIS("PROC"))!$D(DGCDIS("COND"))) S ERROR="'CD STATUS REASON' NOT PRESENT" Q
94 . ; VCD doesn't match determination status?
95 . S ISCD=$$ISCD(.DGCDIS)
96 . I DGCDIS("VCD")="Y",'ISCD S ERROR="Not enough diagnoses/procedures/conditions to qualify for CD Status." Q
97 . I DGCDIS("VCD")="N",ISCD S ERROR="Veteran has enough diagnoses/procedures/conditions to qualify for CD Status." Q
98 . S VALID=1
99 Q VALID
100 ;
101ISCD(DGCDIS) ; Returns 1/0, is the patient CD?
102 ; DGCDIS("DIAG",N)=CD REASON for Diagnosis.
103 ; DGCDIS("COND",N)=CD REASON for Condition.
104 ; DGCDIS("SCORE",N)=SCORE (for condition.)
105 ; DGCDIS("PERM",N)=Permanant Indicator (for condition).
106 ; DGCDIS("PROC",N)=CD REASON for procedure.
107 ; DGCDIS("EXT",N)=Affected Extremity (for procedure.)
108 N CD S CD=0 ; True if patient is CD.
109 N SUB,LIMB,LCODE,EXT,LIEN,EXCLUDE
110 S SUB=""
111 F S SUB=$O(DGCDIS("DIAG",SUB)) Q:SUB="" D
112 . I $$TYPE^DGENA5($G(DGCDIS("DIAG",SUB)))'="D" Q
113 . S CD=CD+1
114 F S SUB=$O(DGCDIS("PROC",SUB)) Q:SUB="" D
115 . I $$TYPE^DGENA5($G(DGCDIS("PROC",SUB)))'="P" Q
116 . S LCODE=0
117 . F S LCODE=$O(DGCDIS("EXT",SUB,LCODE)) Q:'LCODE D
118 . . S EXT=DGCDIS("EXT",SUB,LCODE)
119 . . Q:EXT=""
120 . . S LIEN=$O(^DGEN(27.17,DGCDIS("PROC",SUB),1,"B",EXT,0))
121 . . Q:LIEN=""
122 . . S LIMB=$$LIMBCODE^DGENA5(DGCDIS("PROC",SUB),LIEN)
123 . . I LIMB'=EXT Q
124 . . I $D(EXCLUDE(SUB,LIMB)) Q
125 . . S EXCLUDE(SUB,LIMB)=""
126 . . S CD=CD+.5
127 F S SUB=$O(DGCDIS("COND",SUB)) Q:SUB="" D
128 . I $$TYPE^DGENA5($G(DGCDIS("COND",SUB)))'="C" Q
129 . I '$$RANGEMET^DGENA5(DGCDIS("COND",SUB),DGCDIS("SCORE",SUB),DGCDIS("PERM",SUB)) Q
130 . S CD=CD+1
131 S CD=(CD'<1)
132 ;S DGCDIS("VCD")=$E("NY",CD+1)
133 Q CD
134 ;
135ERRDISP(FILE) ; Display error.
136 N LINE
137 S LINE=0
138 W:$X !
139 W "ERROR updating ",$S(FILE=2.396:"CD DIAGNOSES",FILE=2.397:"CD PROCEDURES",FILE=2.398:"CD CONDITIONS",FILE=2.399!(FILE=2.409):"CD HISTORY",1:"PATIENT CD DATA"),!
140 F S LINE=$O(DGCDERR("DIERR",1,"TEXT",LINE)) Q:'LINE W ?5,DGCDERR("DIERR",1,"TEXT",LINE),!
141 W !
142 Q
143 ;
144DELETE(DFN) ;
145 ;Description: Delete a catastrophic disability record for a patient
146 ;Input:
147 ; DFN - Patient IEN
148 ;Output:
149 ; Function Value - returns 1 if successful, otherwise 0
150 N SUCCESS,DIE,DR,DA,D0,DIC
151 S SUCCESS=1
152 D ;drops out if invalid condition found
153 . I $G(DFN),$D(^DPT(DFN,0))
154 . E S SUCCESS=0 Q
155 . I '$$LOCK(DFN) S SUCCESS=0 Q
156 . S DIE="^DPT("
157 . S DR=".39////@"
158 . S DR=DR_";.391////@"
159 . S DR=DR_";.392////@"
160 . S DR=DR_";.393////@"
161 . S DR=DR_";.394////@"
162 . S DR=DR_";.395////@"
163 . S DR=DR_";.3951////@"
164 . S DR=DR_";.3952////@"
165 . S DR=DR_";.3953////@"
166 . S DA=DFN
167 . D ^DIE
168 . N SIEN,SUBFILE
169 . F SUBFILE=.396,.397,.398 I $D(^DPT(DFN,SUBFILE)) D
170 . . S SIEN=0
171 . . F S SIEN=$O(^DPT(DFN,SUBFILE,SIEN)) Q:'SIEN D
172 . . . N DA,DIE,DR
173 . . . S DIE="^DPT("_DFN_","_SUBFILE_","
174 . . . S DR=".01////@"
175 . . . S DA=SIEN,DA(1)=DFN
176 . . . D ^DIE
177 . ; Note -- CD HISTORY field (#.399) must not be deleted.
178 D UNLOCK(DFN)
179 Q SUCCESS
Note: See TracBrowser for help on using the repository browser.