DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN,TGH - Catastrophic Disability API - File Data;May 24, 1999
;;5.3;Registration;**232,387,653,850,894**;Aug 13,1993;Build 48
;
; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
;
STORE(DFN,DGCDIS,ERROR) ;
;Description: Creates a catastrophic disability record for a patient.
; Attempts to add catastrophically disabled eligibility code.
;Input:
; DFN - Patient IEN
; DGCDIS - the catastrophic disability array, passed by reference
;Output:
; Function Value - returns 1 if successful, otherwise 0
; ERROR - if not successful, an error message is returned,pass
; by reference
N SUCCESS,FDA,SUB,HIEN,HSUB,FDB,NIEN,EIEN,DGCDERR
S SUCCESS=1
S ERROR=""
I DGCDIS("VCD")="N" N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCD(I)="" ; DG*5.3*894
D ;drops out if invalid condition found
. I $G(DFN),$D(^DPT(DFN,0))
. E S SUCCESS=0,ERROR="PATIENT NOT FOUND" Q
. I '$$LOCK^DGENCDA1(DFN) S SUCCESS=0,ERROR="RECORD IN USE, CAN NOT BE EDITED" Q
. I '$$CHECK^DGENCDA1(.DGCDIS,.ERROR) S SUCCESS=0 Q
. S HIEN=$P($G(^DPT(DFN,.399,0)),"^",3)+1
. S HIEN=HIEN_","_DFN_","
. S FDA(2,DFN_",",.39)=DGCDIS("VCD")
. S FDB(2.399,HIEN,.39)=DGCDIS("VCD")
. S FDA(2,DFN_",",.391)=DGCDIS("BY")
. S FDB(2.399,HIEN,.391)=DGCDIS("BY")
. S FDA(2,DFN_",",.392)=DGCDIS("DATE")
. S FDB(2.399,HIEN,.392)=DGCDIS("DATE")
. S FDA(2,DFN_",",.393)=DGCDIS("FACDET")
. S FDB(2.399,HIEN,.393)=DGCDIS("FACDET")
. S FDA(2,DFN_",",.394)=DGCDIS("REVDTE")
. S FDB(2.399,HIEN,.394)=DGCDIS("REVDTE")
. S FDA(2,DFN_",",.395)=DGCDIS("METDET")
. S FDB(2.399,HIEN,.395)=DGCDIS("METDET")
. S FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT")
. S FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT")
. S FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV")
. S FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV")
. S FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT")
. S FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT")
. S SUB="",HSUB=0
. S NIEN=0 F S SUB=$O(DGCDIS("DESCR",SUB)) Q:'SUB D
. . I DGCDIS("DESCR",SUB)="" Q
. . S NIEN=NIEN+1
. . S FDB(2.401,NIEN_","_DFN_",",.01)=DGCDIS("DESCR",SUB)
. . S HSUB=HSUB+1
. . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DESCR",SUB)
. S FDB(2.399,HIEN,.01)=$$NOW^XLFDT
I SUCCESS D
. N SUBFDA,SUBFILE,IENS
. S SUCCESS=$$DELETE^DGENCDA1(DFN)
. Q:'SUCCESS
. D UPDATE^DIE("","FDA","","DGCDERR")
. I $G(DGCDERR) D Q
. . S ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
. . S SUCCESS=0
. . D ERRDISP^DGENCDA1(2)
. S SUBFILE=""
. S ERROR="FILEMAN UPDATE FAILED FOR "
. F S SUBFILE=$O(FDB(SUBFILE)) Q:SUBFILE="" D Q:'SUCCESS
. . N IEN,NODE,ITEM
. . S IEN=""
. . F ITEM=0:1 S IEN=$O(FDB(SUBFILE,IEN)) Q:'IEN D Q:'SUCCESS
. . . N DIC,Y,DO,DD,DINUM,DA,NODE
. . . I SUBFILE'=2.409 D
. . . . S NODE=SUBFILE-2
. . . . S DIC("P")=$P($G(^DD(2,SUBFILE-2,0)),"^",2)
. . . . S DA(1)=DFN
. . . E D
. . . . S NODE=".399,"_$P(IEN,",",2)_",1"
. . . . S DIC("P")=$P($G(^DD(2.399,.396,0)),"^",2)
. . . . S DA(1)=$P(IEN,",",2),DA(2)=DFN
. . . S DIC="^DPT("_DFN_","_NODE_","
. . . S DIC(0)="L"
. . . S X=FDB(SUBFILE,IEN,.01)
. . . S DINUM=+IEN
. . . D FILE^DICN
. . . I Y=-1 S ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE,SUCCESS=0
. . Q:'SUCCESS
. . K SUBFDA
. . M SUBFDA(SUBFILE)=FDB(SUBFILE)
. . D FILE^DIE("","SUBFDA","DGCDERR")
. . I $G(DIERR) D
. . . S ERROR=ERROR_" #"_SUBFILE
. . . S SUCCESS=0
. . . D ERRDISP^DGENCDA1(SUBFILE)
. I SUCCESS S ERROR=""
D CLEAN^DILF
D UNLOCK^DGENCDA1(DFN)
Q SUCCESS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCDA2 3627 printed Oct 16, 2024@18:43:08 Page 2
DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN,TGH - Catastrophic Disability API - File Data;May 24, 1999
+1 ;;5.3;Registration;**232,387,653,850,894**;Aug 13,1993;Build 48
+2 ;
+3 ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
+4 ;
STORE(DFN,DGCDIS,ERROR) ;
+1 ;Description: Creates a catastrophic disability record for a patient.
+2 ; Attempts to add catastrophically disabled eligibility code.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ; DGCDIS - the catastrophic disability array, passed by reference
+6 ;Output:
+7 ; Function Value - returns 1 if successful, otherwise 0
+8 ; ERROR - if not successful, an error message is returned,pass
+9 ; by reference
+10 NEW SUCCESS,FDA,SUB,HIEN,HSUB,FDB,NIEN,EIEN,DGCDERR
+11 SET SUCCESS=1
+12 SET ERROR=""
+13 ; DG*5.3*894
IF DGCDIS("VCD")="N"
NEW I
FOR I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT"
SET DGCD(I)=""
+14 ;drops out if invalid condition found
Begin DoDot:1
+15 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
+16 IF '$TEST
SET SUCCESS=0
SET ERROR="PATIENT NOT FOUND"
QUIT
+17 IF '$$LOCK^DGENCDA1(DFN)
SET SUCCESS=0
SET ERROR="RECORD IN USE, CAN NOT BE EDITED"
QUIT
+18 IF '$$CHECK^DGENCDA1(.DGCDIS,.ERROR)
SET SUCCESS=0
QUIT
+19 SET HIEN=$PIECE($GET(^DPT(DFN,.399,0)),"^",3)+1
+20 SET HIEN=HIEN_","_DFN_","
+21 SET FDA(2,DFN_",",.39)=DGCDIS("VCD")
+22 SET FDB(2.399,HIEN,.39)=DGCDIS("VCD")
+23 SET FDA(2,DFN_",",.391)=DGCDIS("BY")
+24 SET FDB(2.399,HIEN,.391)=DGCDIS("BY")
+25 SET FDA(2,DFN_",",.392)=DGCDIS("DATE")
+26 SET FDB(2.399,HIEN,.392)=DGCDIS("DATE")
+27 SET FDA(2,DFN_",",.393)=DGCDIS("FACDET")
+28 SET FDB(2.399,HIEN,.393)=DGCDIS("FACDET")
+29 SET FDA(2,DFN_",",.394)=DGCDIS("REVDTE")
+30 SET FDB(2.399,HIEN,.394)=DGCDIS("REVDTE")
+31 SET FDA(2,DFN_",",.395)=DGCDIS("METDET")
+32 SET FDB(2.399,HIEN,.395)=DGCDIS("METDET")
+33 SET FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT")
+34 SET FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT")
+35 SET FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV")
+36 SET FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV")
+37 SET FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT")
+38 SET FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT")
+39 SET SUB=""
SET HSUB=0
+40 SET NIEN=0
FOR
SET SUB=$ORDER(DGCDIS("DESCR",SUB))
if 'SUB
QUIT
Begin DoDot:2
+41 IF DGCDIS("DESCR",SUB)=""
QUIT
+42 SET NIEN=NIEN+1
+43 SET FDB(2.401,NIEN_","_DFN_",",.01)=DGCDIS("DESCR",SUB)
+44 SET HSUB=HSUB+1
+45 SET FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DESCR",SUB)
End DoDot:2
+46 SET FDB(2.399,HIEN,.01)=$$NOW^XLFDT
End DoDot:1
+47 IF SUCCESS
Begin DoDot:1
+48 NEW SUBFDA,SUBFILE,IENS
+49 SET SUCCESS=$$DELETE^DGENCDA1(DFN)
+50 if 'SUCCESS
QUIT
+51 DO UPDATE^DIE("","FDA","","DGCDERR")
+52 IF $GET(DGCDERR)
Begin DoDot:2
+53 SET ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
+54 SET SUCCESS=0
+55 DO ERRDISP^DGENCDA1(2)
End DoDot:2
QUIT
+56 SET SUBFILE=""
+57 SET ERROR="FILEMAN UPDATE FAILED FOR "
+58 FOR
SET SUBFILE=$ORDER(FDB(SUBFILE))
if SUBFILE=""
QUIT
Begin DoDot:2
+59 NEW IEN,NODE,ITEM
+60 SET IEN=""
+61 FOR ITEM=0:1
SET IEN=$ORDER(FDB(SUBFILE,IEN))
if 'IEN
QUIT
Begin DoDot:3
+62 NEW DIC,Y,DO,DD,DINUM,DA,NODE
+63 IF SUBFILE'=2.409
Begin DoDot:4
+64 SET NODE=SUBFILE-2
+65 SET DIC("P")=$PIECE($GET(^DD(2,SUBFILE-2,0)),"^",2)
+66 SET DA(1)=DFN
End DoDot:4
+67 IF '$TEST
Begin DoDot:4
+68 SET NODE=".399,"_$PIECE(IEN,",",2)_",1"
+69 SET DIC("P")=$PIECE($GET(^DD(2.399,.396,0)),"^",2)
+70 SET DA(1)=$PIECE(IEN,",",2)
SET DA(2)=DFN
End DoDot:4
+71 SET DIC="^DPT("_DFN_","_NODE_","
+72 SET DIC(0)="L"
+73 SET X=FDB(SUBFILE,IEN,.01)
+74 SET DINUM=+IEN
+75 DO FILE^DICN
+76 IF Y=-1
SET ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE
SET SUCCESS=0
End DoDot:3
if 'SUCCESS
QUIT
+77 if 'SUCCESS
QUIT
+78 KILL SUBFDA
+79 MERGE SUBFDA(SUBFILE)=FDB(SUBFILE)
+80 DO FILE^DIE("","SUBFDA","DGCDERR")
+81 IF $GET(DIERR)
Begin DoDot:3
+82 SET ERROR=ERROR_" #"_SUBFILE
+83 SET SUCCESS=0
+84 DO ERRDISP^DGENCDA1(SUBFILE)
End DoDot:3
End DoDot:2
if 'SUCCESS
QUIT
+85 IF SUCCESS
SET ERROR=""
End DoDot:1
+86 DO CLEAN^DILF
+87 DO UNLOCK^DGENCDA1(DFN)
+88 QUIT SUCCESS
