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

DGENCDA1.m

Go to the documentation of this file.
  1. DGENCDA1 ;ALB/CJM,RMM Zoltan,JAN,PHH,BRM,CKN,DJS - Catastrophic Disabilty API - File Data;Sep 16, 2002 ; 9/22/05 5:25pm
  1. ;;5.3;Registration;**121,147,232,302,356,387,475,451,653,894**;Aug 13,1993;Build 48
  1. ;
  1. ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
  1. ;
  1. LOCK(DFN) ;
  1. ;Description: Locks the catastrophic disability record for a patient
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ;Output:
  1. ; Function Value - returns 1 if the patient is catastrophic disability
  1. ; record can be locked, otherwise 0
  1. I $G(DFN) L +^DPT(DFN,.39):2
  1. Q $T
  1. ;
  1. UNLOCK(DFN) ;
  1. ;Description: Unlocks the catastrophic disability record for a patient
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ;Output:
  1. ; None
  1. I $G(DFN) L -^DPT(DFN,.39)
  1. Q
  1. ;
  1. CHECK(DGCDIS,ERROR) ;
  1. ;Description: Validity checks on the catastrophic disability contained
  1. ; in the DGCDIS array
  1. ;Input:
  1. ; DGCDIS - the catastrophic disability array, passed by reference
  1. ;Output:
  1. ; Function Value - returns 1 if validation checks passed, 0 otherwise
  1. ; ERROR - if validation fails an error mssg is returned, pass by
  1. ; reference
  1. N VALID,RESULT,EXTERNAL,ITEM,EIEN,EXIT,OK,ISCD,POP,FLD
  1. S ERROR=""
  1. Q:DGCDIS("VCD")="@" 1 ;this is a deletion
  1. Q:DGCDIS("VCD")="N" 1 ;NO value for VCD
  1. D ;drops out of block if invalid condition found
  1. . S VALID=0 ; Usually invalid if it exits early.
  1. . ; CD Flag must have a value if any other CD field is populated
  1. . S POP=0
  1. . I DGCDIS("VCD")="" D Q:POP
  1. . . F FLD="BY","DATE","FACDET","REVDTE","METDET" D Q:POP
  1. . . . I $G(DGCDIS(FLD))]"" S POP=1
  1. . . I POP S ERROR="'VETERAN CATASTROPHICALLY DISABLED?' FIELD MUST HAVE A RESPONSE" Q
  1. . ; Decided by.
  1. . I DGCDIS("VCD")'="",$G(DGCDIS("BY"))="" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' REQUIRED" Q
  1. . I $G(DGCDIS("BY"))'="",($L(DGCDIS("BY"))<3)!($L(DGCDIS("BY"))>35) S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' NOT VALID" Q
  1. . I $$UPPER^DGUTL($G(DGCDIS("BY")))="HINQ" S ERROR="CATASTROPHIC DISABILITY 'DECIDED BY' CAN NOT BE 'HINQ'" Q
  1. . ; Date of Decision
  1. . S OK=1,EXTERNAL=""
  1. . I DGCDIS("VCD")'="",$G(DGCDIS("DATE"))="" S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' REQUIRED" Q
  1. . I $G(DGCDIS("DATE"))'="" D
  1. . . I 'DGCDIS("DATE") S OK=0 Q
  1. . . S EXTERNAL=$$EXTERNAL^DILFD(2,.392,"",DGCDIS("DATE"))
  1. . . I EXTERNAL="" S OK=0
  1. . . D CHK^DIE(2,.392,,EXTERNAL,.RESULT)
  1. . . I RESULT="^" S OK=0
  1. . I 'OK S ERROR="'DATE OF CATASTOPHIC DISABILITY DECISION' NOT VALID" Q
  1. . ; Facility Making Determination.
  1. . I DGCDIS("VCD")'=""!(DGCDIS("FACDET")'=""),$$EXTERNAL^DILFD(2,.393,"",$G(DGCDIS("FACDET")))="" S ERROR="'FACILITY MAKING CATASTROPHIC DISABILITY DETERMINATION' NOT VALID" Q
  1. . ; Review Date
  1. . I DGCDIS("VCD")'="",$G(DGCDIS("REVDTE"))="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' REQUIRED" Q
  1. . I DGCDIS("REVDTE")'="" D Q:ERROR'=""
  1. . . S EXTERNAL=$$EXTERNAL^DILFD(2,.394,"",DGCDIS("REVDTE"))
  1. . . I EXTERNAL="" S ERROR="'CATASTROPHIC DISABILITY REVIEW DATE' NOT VALID" Q
  1. . . D CHK^DIE(2,.394,,EXTERNAL,.RESULT)
  1. . . I RESULT="^" S ERROR="'CATASTROPHIC DISABILTY REVIEW DATE' INVALID" Q
  1. . . I $G(DGCDIS("DATE")),DGCDIS("REVDTE")>DGCDIS("DATE") S ERROR="'CD REVIEW DATE' GREATER THAN 'CD DATE OF DETERMINATION'." Q
  1. . ; Method of Determination
  1. . I $G(DGCDIS("METDET"))="",DGCDIS("VCD")'="" S ERROR="'METHOD OF DETERMINATION' IS A REQUIRED VALUE." Q
  1. . I "..2.3."'[("."_$G(DGCDIS("METDET"))_".") S ERROR="'METHOD OF DETERMINATION' NOT VALID" Q
  1. . S ITEM="",EXIT=0
  1. . ; Descriptor
  1. . F S ITEM=$O(DGCDIS("DESCR",ITEM)) Q:'ITEM Q:EXIT D
  1. . . I DGCDIS("DESCR",ITEM)="" Q
  1. . . I $$TYPE^DGENA5(DGCDIS("DESCR",ITEM))'="DE" S EXIT=1,ERROR="'CD DESCRIPTOR' NOT VALID"
  1. . Q:EXIT
  1. . ; Diagnoses
  1. . F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:'ITEM Q:EXIT D
  1. . . I DGCDIS("DIAG",ITEM)="" Q
  1. . . I $$TYPE^DGENA5(DGCDIS("DIAG",ITEM))'="D" S EXIT=1,ERROR="'CD STATUS DIAGNOSES' NOT VALID"
  1. . Q:EXIT
  1. . ; Procedures
  1. . F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:'ITEM Q:EXIT D
  1. . . I DGCDIS("PROC",ITEM)="" Q
  1. . . I $$TYPE^DGENA5(DGCDIS("PROC",ITEM))'="P" S EXIT=1,ERROR="'CD STATUS PROCEDURE' NOT VALID" Q
  1. . . S EIEN="" F S EIEN=$O(DGCDIS("EXT",ITEM,EIEN)) Q:EIEN="" D
  1. . . . I '$$LIMBOK^DGENA5(DGCDIS("PROC",ITEM),DGCDIS("EXT",ITEM,EIEN)) S EXIT=1,ERROR="'CD STATUS AFFECTED EXTREMITY' INVALID"
  1. . Q:EXIT
  1. . ; Conditions
  1. . F S ITEM=$O(DGCDIS("COND",ITEM)) Q:'ITEM Q:EXIT D
  1. . . I DGCDIS("COND",ITEM)="" Q
  1. . . I $$TYPE^DGENA5(DGCDIS("COND",ITEM))'="C" S EXIT=1,ERROR="'' NOT VALID" Q
  1. . . I '$$VALID^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM)) S EXIT=1,ERROR="'CD CONDITION SCORE' NOT VALID" Q
  1. . . I ".1.2.3."'[("."_DGCDIS("PERM",ITEM)_".") S ERROR="'PERMANENT STATUS INDICATOR' NOT VALID" Q
  1. . Q:EXIT
  1. . ; No reason present?
  1. . I DGCDIS("VCD")="Y",('$D(DGCDIS("DESCR"))&('$D(DGCDIS("DIAG")))&('$D(DGCDIS("PROC")))&('$D(DGCDIS("COND")))) S ERROR="'CD REASON' NOT PRESENT" Q
  1. . S VALID=1
  1. Q VALID
  1. ;
  1. ISCD(DGCDIS) ; Returns 1/0, is the patient CD?
  1. ; DGCDIS("DESCR",N)=CD REASON for Descriptor.
  1. ; DGCDIS("DIAG",N)=CD REASON for Diagnosis.
  1. ; DGCDIS("COND",N)=CD REASON for Condition.
  1. ; DGCDIS("SCORE",N)=SCORE (for condition.)
  1. ; DGCDIS("PERM",N)=Permanent Indicator (for condition).
  1. ; DGCDIS("PROC",N)=CD REASON for procedure.
  1. ; DGCDIS("EXT",N)=Affected Extremity (for procedure.)
  1. N CD S CD=0 ; True if patient is CD.
  1. N SUB,LIMB,LCODE,EXT,LIEN,EXCLUDE
  1. S SUB=""
  1. ; DG*5.3*894 - Add Descriptor
  1. F S SUB=$O(DGCDIS("DESCR",SUB)) Q:SUB="" D
  1. . I $$TYPE^DGENA5($G(DGCDIS("DESCR",SUB)))'="DE" Q
  1. . S CD=CD+1
  1. F S SUB=$O(DGCDIS("DIAG",SUB)) Q:SUB="" D
  1. . I $$TYPE^DGENA5($G(DGCDIS("DIAG",SUB)))'="D" Q
  1. . S CD=CD+1
  1. F S SUB=$O(DGCDIS("PROC",SUB)) Q:SUB="" D
  1. . I $$TYPE^DGENA5($G(DGCDIS("PROC",SUB)))'="P" Q
  1. . S LCODE=0
  1. . F S LCODE=$O(DGCDIS("EXT",SUB,LCODE)) Q:'LCODE D
  1. . . S EXT=DGCDIS("EXT",SUB,LCODE)
  1. . . Q:EXT=""
  1. . . S LIEN=$O(^DGEN(27.17,DGCDIS("PROC",SUB),1,"B",EXT,0))
  1. . . Q:LIEN=""
  1. . . S LIMB=$$LIMBCODE^DGENA5(DGCDIS("PROC",SUB),LIEN)
  1. . . I LIMB'=EXT Q
  1. . . I $D(EXCLUDE(SUB,LIMB)) Q
  1. . . S EXCLUDE(SUB,LIMB)=""
  1. . . S CD=CD+.5
  1. F S SUB=$O(DGCDIS("COND",SUB)) Q:SUB="" D
  1. . I $$TYPE^DGENA5($G(DGCDIS("COND",SUB)))'="C" Q
  1. . I '$$RANGEMET^DGENA5(DGCDIS("COND",SUB),DGCDIS("SCORE",SUB),DGCDIS("PERM",SUB)) Q
  1. . S CD=CD+1
  1. S CD=(CD'<1)
  1. Q CD
  1. ;
  1. ERRDISP(FILE) ; Display error.
  1. N LINE
  1. S LINE=0
  1. W:$X !
  1. W "ERROR updating ",$S(FILE=2.401:"CD DESCRIPTORS",FILE=2.399!(FILE=2.409):"CD HISTORY",1:"PATIENT CD DATA"),!
  1. F S LINE=$O(DGCDERR("DIERR",1,"TEXT",LINE)) Q:'LINE W ?5,DGCDERR("DIERR",1,"TEXT",LINE),!
  1. W !
  1. Q
  1. ;
  1. DELETE(DFN) ;
  1. ;Description: Delete a catastrophic disability record for a patient
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ;Output:
  1. ; Function Value - returns 1 if successful, otherwise 0
  1. N SUCCESS,DIK,DA
  1. S SUCCESS=1
  1. D ;drops out if invalid condition found
  1. . I $G(DFN),$D(^DPT(DFN,0))
  1. . E S SUCCESS=0 Q
  1. . I '$$LOCK(DFN) S SUCCESS=0 Q
  1. . ;
  1. . N DA,DIK
  1. . S DA(1)=DFN
  1. . S DA=.39
  1. . S DIK="^DPT("_DFN_","_DA_","
  1. . D ^DIK
  1. . ;
  1. . N SIEN,SUBFILE
  1. . F SUBFILE=.401,.396,.397,.398 I $D(^DPT(DFN,SUBFILE)) D
  1. . . S SIEN=0
  1. . . F S SIEN=$O(^DPT(DFN,SUBFILE,SIEN)) Q:SIEN="" Q:SIEN'?.N D
  1. . . . N DA,DIK
  1. . . . S DA=SIEN
  1. . . . S DA(1)=DFN
  1. . . . S DIK="^DPT("_DFN_","_SUBFILE_","
  1. . . . D ^DIK
  1. . ;
  1. . N DA,DIK
  1. . S DA(1)=DFN
  1. . S DA=2.401
  1. . S DIK="^DPT("_DFN_","
  1. . D ^DIK
  1. . ; Note -- CD HISTORY field (#.399) must not be deleted.
  1. D UNLOCK(DFN)
  1. Q SUCCESS
  1. ;