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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1DGENCDA2 ;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 ;
4STORE(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
Note: See TracBrowser for help on using the repository browser.