| [613] | 1 | DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN - Catastrophic Disabilty API - File Data;May 24, 1999,Nov 14, 2001 ; 9/22/05 5:40pm
|
|---|
| 2 | ;;5.3;Registration;**232,387,653**;Aug 13,1993;Build 2
|
|---|
| 3 | ;
|
|---|
| 4 | STORE(DFN,DGCDIS,ERROR) ;
|
|---|
| 5 | ;Description: Creates a catastrophic disability record for a patient.
|
|---|
| 6 | ; Attempts to add catastrophically disabled eligibility code.
|
|---|
| 7 | ;Input:
|
|---|
| 8 | ; DFN - Patient IEN
|
|---|
| 9 | ; DGCDIS - the catastrophic disability array, passed by reference
|
|---|
| 10 | ;Output:
|
|---|
| 11 | ; Function Value - returns 1 if successful, otherwise 0
|
|---|
| 12 | ; ERROR - if not successful, an error message is returned,pass
|
|---|
| 13 | ; by reference
|
|---|
| 14 | N SUCCESS,FDA,SUB,HIEN,HSUB,FDB,NIEN,EIEN
|
|---|
| 15 | S SUCCESS=1
|
|---|
| 16 | S ERROR=""
|
|---|
| 17 | D ;drops out if invalid condition found
|
|---|
| 18 | . I $G(DFN),$D(^DPT(DFN,0))
|
|---|
| 19 | . E S SUCCESS=0,ERROR="PATIENT NOT FOUND" Q
|
|---|
| 20 | . I '$$LOCK^DGENCDA1(DFN) S SUCCESS=0,ERROR="RECORD IN USE, CAN NOT BE EDITED" Q
|
|---|
| 21 | . I '$$CHECK^DGENCDA1(.DGCDIS,.ERROR) S SUCCESS=0 Q
|
|---|
| 22 | . S HIEN=$P($G(^DPT(DFN,.399,0)),"^",3)+1
|
|---|
| 23 | . S HIEN=HIEN_","_DFN_","
|
|---|
| 24 | . S FDA(2,DFN_",",.39)=DGCDIS("VCD")
|
|---|
| 25 | . S FDB(2.399,HIEN,.39)=DGCDIS("VCD")
|
|---|
| 26 | . S FDA(2,DFN_",",.391)=DGCDIS("BY")
|
|---|
| 27 | . S FDB(2.399,HIEN,.391)=DGCDIS("BY")
|
|---|
| 28 | . S FDA(2,DFN_",",.392)=DGCDIS("DATE")
|
|---|
| 29 | . S FDB(2.399,HIEN,.392)=DGCDIS("DATE")
|
|---|
| 30 | . S FDA(2,DFN_",",.393)=DGCDIS("FACDET")
|
|---|
| 31 | . S FDB(2.399,HIEN,.393)=DGCDIS("FACDET")
|
|---|
| 32 | . S FDA(2,DFN_",",.394)=DGCDIS("REVDTE")
|
|---|
| 33 | . S FDB(2.399,HIEN,.394)=DGCDIS("REVDTE")
|
|---|
| 34 | . S FDA(2,DFN_",",.395)=DGCDIS("METDET")
|
|---|
| 35 | . S FDB(2.399,HIEN,.395)=DGCDIS("METDET")
|
|---|
| 36 | . S FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT")
|
|---|
| 37 | . S FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT")
|
|---|
| 38 | . S FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV")
|
|---|
| 39 | . S FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV")
|
|---|
| 40 | . S FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT")
|
|---|
| 41 | . S FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT")
|
|---|
| 42 | . S SUB="",HSUB=0
|
|---|
| 43 | . S NIEN=0 F S SUB=$O(DGCDIS("DIAG",SUB)) Q:'SUB D
|
|---|
| 44 | . . I DGCDIS("DIAG",SUB)="" Q
|
|---|
| 45 | . . S NIEN=NIEN+1
|
|---|
| 46 | . . S FDB(2.396,NIEN_","_DFN_",",.01)=DGCDIS("DIAG",SUB)
|
|---|
| 47 | . . S HSUB=HSUB+1
|
|---|
| 48 | . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DIAG",SUB)
|
|---|
| 49 | . S NIEN=0 F S SUB=$O(DGCDIS("PROC",SUB)) Q:'SUB D
|
|---|
| 50 | . . I DGCDIS("PROC",SUB)="" Q
|
|---|
| 51 | . . S EIEN=0 F S EIEN=$O(DGCDIS("EXT",SUB,EIEN)) Q:'EIEN D
|
|---|
| 52 | . . . S NIEN=NIEN+1
|
|---|
| 53 | . . . S FDB(2.397,NIEN_","_DFN_",",.01)=DGCDIS("PROC",SUB)
|
|---|
| 54 | . . . S HSUB=HSUB+1
|
|---|
| 55 | . . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("PROC",SUB)
|
|---|
| 56 | . . . S FDB(2.397,NIEN_","_DFN_",",1)=DGCDIS("EXT",SUB,EIEN)
|
|---|
| 57 | . . . S FDB(2.409,HSUB_","_HIEN,1)=DGCDIS("EXT",SUB,EIEN)
|
|---|
| 58 | . S NIEN=0 F S SUB=$O(DGCDIS("COND",SUB)) Q:'SUB D
|
|---|
| 59 | . . I DGCDIS("COND",SUB)="" Q
|
|---|
| 60 | . . S NIEN=NIEN+1
|
|---|
| 61 | . . S FDB(2.398,NIEN_","_DFN_",",.01)=DGCDIS("COND",SUB)
|
|---|
| 62 | . . S HSUB=HSUB+1
|
|---|
| 63 | . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("COND",SUB)
|
|---|
| 64 | . . S FDB(2.398,NIEN_","_DFN_",",1)=DGCDIS("SCORE",SUB)
|
|---|
| 65 | . . S FDB(2.409,HSUB_","_HIEN,2)=DGCDIS("SCORE",SUB)
|
|---|
| 66 | . . S FDB(2.398,NIEN_","_DFN_",",2)=DGCDIS("PERM",SUB)
|
|---|
| 67 | . . S FDB(2.409,HSUB_","_HIEN,3)=DGCDIS("PERM",SUB)
|
|---|
| 68 | . S FDB(2.399,HIEN,.01)=$$NOW^XLFDT
|
|---|
| 69 | I SUCCESS D
|
|---|
| 70 | . N SUBFDA,SUBFILE
|
|---|
| 71 | . S SUCCESS=$$DELETE^DGENCDA1(DFN)
|
|---|
| 72 | . Q:'SUCCESS
|
|---|
| 73 | . D FILE^DIE("K","FDA","DGCDERR")
|
|---|
| 74 | . I $G(DIERR) D Q
|
|---|
| 75 | . . S ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
|
|---|
| 76 | . . S SUCCESS=0
|
|---|
| 77 | . . D ERRDISP^DGENCDA1(2)
|
|---|
| 78 | . S SUBFILE=""
|
|---|
| 79 | . S ERROR="FILEMAN UPDATE FAILED FOR "
|
|---|
| 80 | . F S SUBFILE=$O(FDB(SUBFILE)) Q:SUBFILE="" D Q:'SUCCESS
|
|---|
| 81 | . . N IEN,NODE,ITEM
|
|---|
| 82 | . . S IEN=""
|
|---|
| 83 | . . F ITEM=0:1 S IEN=$O(FDB(SUBFILE,IEN)) Q:'IEN D Q:'SUCCESS
|
|---|
| 84 | . . . N DIC,Y,DO,DD,DINUM,DA,NODE
|
|---|
| 85 | . . . I SUBFILE'=2.409 D
|
|---|
| 86 | . . . . S NODE=SUBFILE-2
|
|---|
| 87 | . . . . S DIC("P")=$P($G(^DD(2,SUBFILE-2,0)),"^",2)
|
|---|
| 88 | . . . . S DA(1)=DFN
|
|---|
| 89 | . . . E D
|
|---|
| 90 | . . . . S NODE=".399,"_$P(IEN,",",2)_",1"
|
|---|
| 91 | . . . . S DIC("P")=$P($G(^DD(2.399,.396,0)),"^",2)
|
|---|
| 92 | . . . . S DA(1)=$P(IEN,",",2),DA(2)=DFN
|
|---|
| 93 | . . . S DIC="^DPT("_DFN_","_NODE_","
|
|---|
| 94 | . . . S DIC(0)="L"
|
|---|
| 95 | . . . S X=FDB(SUBFILE,IEN,.01)
|
|---|
| 96 | . . . S DINUM=+IEN
|
|---|
| 97 | . . . D FILE^DICN
|
|---|
| 98 | . . . I Y=-1 S ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE,SUCCESS=0
|
|---|
| 99 | . . Q:'SUCCESS
|
|---|
| 100 | . . K SUBFDA
|
|---|
| 101 | . . M SUBFDA(SUBFILE)=FDB(SUBFILE)
|
|---|
| 102 | . . D FILE^DIE("K","SUBFDA","DGCDERR")
|
|---|
| 103 | . . I $G(DIERR) D
|
|---|
| 104 | . . . S ERROR=ERROR_" #"_SUBFILE
|
|---|
| 105 | . . . S SUCCESS=0
|
|---|
| 106 | . . . D ERRDISP^DGENCDA1(SUBFILE)
|
|---|
| 107 | . I SUCCESS S ERROR=""
|
|---|
| 108 | D CLEAN^DILF
|
|---|
| 109 | D UNLOCK^DGENCDA1(DFN)
|
|---|
| 110 | Q SUCCESS
|
|---|
