| [613] | 1 | DGENCDA1 ;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 | ;
|
|---|
| 4 | LOCK(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 | ;
|
|---|
| 14 | UNLOCK(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 | ;
|
|---|
| 23 | CHECK(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 | ;
|
|---|
| 101 | ISCD(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 | ;
|
|---|
| 135 | ERRDISP(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 | ;
|
|---|
| 144 | DELETE(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
|
|---|
