DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN - Catastrophic Disabilty API - File Data;May 24, 1999,Nov 14, 2001 ; 9/22/05 5:40pm
;;5.3;Registration;**232,387,653,1015**;Aug 13,1993;Build 21
;
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
S SUCCESS=1
S ERROR=""
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("DIAG",SUB)) Q:'SUB D
. . I DGCDIS("DIAG",SUB)="" Q
. . S NIEN=NIEN+1
. . S FDB(2.396,NIEN_","_DFN_",",.01)=DGCDIS("DIAG",SUB)
. . S HSUB=HSUB+1
. . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DIAG",SUB)
. S NIEN=0 F S SUB=$O(DGCDIS("PROC",SUB)) Q:'SUB D
. . I DGCDIS("PROC",SUB)="" Q
. . S EIEN=0 F S EIEN=$O(DGCDIS("EXT",SUB,EIEN)) Q:'EIEN D
. . . S NIEN=NIEN+1
. . . S FDB(2.397,NIEN_","_DFN_",",.01)=DGCDIS("PROC",SUB)
. . . S HSUB=HSUB+1
. . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("PROC",SUB)
. . . S FDB(2.397,NIEN_","_DFN_",",1)=DGCDIS("EXT",SUB,EIEN)
. . . S FDB(2.409,HSUB_","_HIEN,1)=DGCDIS("EXT",SUB,EIEN)
. S NIEN=0 F S SUB=$O(DGCDIS("COND",SUB)) Q:'SUB D
. . I DGCDIS("COND",SUB)="" Q
. . S NIEN=NIEN+1
. . S FDB(2.398,NIEN_","_DFN_",",.01)=DGCDIS("COND",SUB)
. . S HSUB=HSUB+1
. . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("COND",SUB)
. . S FDB(2.398,NIEN_","_DFN_",",1)=DGCDIS("SCORE",SUB)
. . S FDB(2.409,HSUB_","_HIEN,2)=DGCDIS("SCORE",SUB)
. . S FDB(2.398,NIEN_","_DFN_",",2)=DGCDIS("PERM",SUB)
. . S FDB(2.409,HSUB_","_HIEN,3)=DGCDIS("PERM",SUB)
. S FDB(2.399,HIEN,.01)=$$NOW^XLFDT
I SUCCESS D
. N SUBFDA,SUBFILE
. S SUCCESS=$$DELETE^DGENCDA1(DFN)
. Q:'SUCCESS
. D FILE^DIE("K","FDA","DGCDERR")
. I $G(DIERR) 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("K","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
DGENCDA2 ;ALB/CJM,ISA/KWP,Zoltan,JAN,CKN - Catastrophic Disabilty API - File Data;May 24, 1999,Nov 14, 2001 ; 9/22/05 5:40pm
+1 ;;5.3;Registration;**232,387,653,1015**;Aug 13,1993;Build 21
+2 ;
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
+11 SET SUCCESS=1
+12 SET ERROR=""
+13 ;drops out if invalid condition found
Begin DoDot:1
+14 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
+15 IF '$TEST
SET SUCCESS=0
SET ERROR="PATIENT NOT FOUND"
QUIT
+16 IF '$$LOCK^DGENCDA1(DFN)
SET SUCCESS=0
SET ERROR="RECORD IN USE, CAN NOT BE EDITED"
QUIT
+17 IF '$$CHECK^DGENCDA1(.DGCDIS,.ERROR)
SET SUCCESS=0
QUIT
+18 SET HIEN=$PIECE($GET(^DPT(DFN,.399,0)),"^",3)+1
+19 SET HIEN=HIEN_","_DFN_","
+20 SET FDA(2,DFN_",",.39)=DGCDIS("VCD")
+21 SET FDB(2.399,HIEN,.39)=DGCDIS("VCD")
+22 SET FDA(2,DFN_",",.391)=DGCDIS("BY")
+23 SET FDB(2.399,HIEN,.391)=DGCDIS("BY")
+24 SET FDA(2,DFN_",",.392)=DGCDIS("DATE")
+25 SET FDB(2.399,HIEN,.392)=DGCDIS("DATE")
+26 SET FDA(2,DFN_",",.393)=DGCDIS("FACDET")
+27 SET FDB(2.399,HIEN,.393)=DGCDIS("FACDET")
+28 SET FDA(2,DFN_",",.394)=DGCDIS("REVDTE")
+29 SET FDB(2.399,HIEN,.394)=DGCDIS("REVDTE")
+30 SET FDA(2,DFN_",",.395)=DGCDIS("METDET")
+31 SET FDB(2.399,HIEN,.395)=DGCDIS("METDET")
+32 SET FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT")
+33 SET FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT")
+34 SET FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV")
+35 SET FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV")
+36 SET FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT")
+37 SET FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT")
+38 SET SUB=""
SET HSUB=0
+39 SET NIEN=0
FOR
SET SUB=$ORDER(DGCDIS("DIAG",SUB))
IF 'SUB
QUIT
Begin DoDot:2
+40 IF DGCDIS("DIAG",SUB)=""
QUIT
+41 SET NIEN=NIEN+1
+42 SET FDB(2.396,NIEN_","_DFN_",",.01)=DGCDIS("DIAG",SUB)
+43 SET HSUB=HSUB+1
+44 SET FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DIAG",SUB)
End DoDot:2
+45 SET NIEN=0
FOR
SET SUB=$ORDER(DGCDIS("PROC",SUB))
IF 'SUB
QUIT
Begin DoDot:2
+46 IF DGCDIS("PROC",SUB)=""
QUIT
+47 SET EIEN=0
FOR
SET EIEN=$ORDER(DGCDIS("EXT",SUB,EIEN))
IF 'EIEN
QUIT
Begin DoDot:3
+48 SET NIEN=NIEN+1
+49 SET FDB(2.397,NIEN_","_DFN_",",.01)=DGCDIS("PROC",SUB)
+50 SET HSUB=HSUB+1
+51 SET FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("PROC",SUB)
+52 SET FDB(2.397,NIEN_","_DFN_",",1)=DGCDIS("EXT",SUB,EIEN)
+53 SET FDB(2.409,HSUB_","_HIEN,1)=DGCDIS("EXT",SUB,EIEN)
End DoDot:3
End DoDot:2
+54 SET NIEN=0
FOR
SET SUB=$ORDER(DGCDIS("COND",SUB))
IF 'SUB
QUIT
Begin DoDot:2
+55 IF DGCDIS("COND",SUB)=""
QUIT
+56 SET NIEN=NIEN+1
+57 SET FDB(2.398,NIEN_","_DFN_",",.01)=DGCDIS("COND",SUB)
+58 SET HSUB=HSUB+1
+59 SET FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("COND",SUB)
+60 SET FDB(2.398,NIEN_","_DFN_",",1)=DGCDIS("SCORE",SUB)
+61 SET FDB(2.409,HSUB_","_HIEN,2)=DGCDIS("SCORE",SUB)
+62 SET FDB(2.398,NIEN_","_DFN_",",2)=DGCDIS("PERM",SUB)
+63 SET FDB(2.409,HSUB_","_HIEN,3)=DGCDIS("PERM",SUB)
End DoDot:2
+64 SET FDB(2.399,HIEN,.01)=$$NOW^XLFDT
End DoDot:1
+65 IF SUCCESS
Begin DoDot:1
+66 NEW SUBFDA,SUBFILE
+67 SET SUCCESS=$$DELETE^DGENCDA1(DFN)
+68 IF 'SUCCESS
QUIT
+69 DO FILE^DIE("K","FDA","DGCDERR")
+70 IF $GET(DIERR)
Begin DoDot:2
+71 SET ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
+72 SET SUCCESS=0
+73 DO ERRDISP^DGENCDA1(2)
End DoDot:2
QUIT
+74 SET SUBFILE=""
+75 SET ERROR="FILEMAN UPDATE FAILED FOR "
+76 FOR
SET SUBFILE=$ORDER(FDB(SUBFILE))
IF SUBFILE=""
QUIT
Begin DoDot:2
+77 NEW IEN,NODE,ITEM
+78 SET IEN=""
+79 FOR ITEM=0:1
SET IEN=$ORDER(FDB(SUBFILE,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+80 NEW DIC,Y,DO,DD,DINUM,DA,NODE
+81 IF SUBFILE'=2.409
Begin DoDot:4
+82 SET NODE=SUBFILE-2
+83 SET DIC("P")=$PIECE($GET(^DD(2,SUBFILE-2,0)),"^",2)
+84 SET DA(1)=DFN
End DoDot:4
+85 IF '$TEST
Begin DoDot:4
+86 SET NODE=".399,"_$PIECE(IEN,",",2)_",1"
+87 SET DIC("P")=$PIECE($GET(^DD(2.399,.396,0)),"^",2)
+88 SET DA(1)=$PIECE(IEN,",",2)
SET DA(2)=DFN
End DoDot:4
+89 SET DIC="^DPT("_DFN_","_NODE_","
+90 SET DIC(0)="L"
+91 SET X=FDB(SUBFILE,IEN,.01)
+92 SET DINUM=+IEN
+93 DO FILE^DICN
+94 IF Y=-1
SET ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE
SET SUCCESS=0
End DoDot:3
IF 'SUCCESS
QUIT
+95 IF 'SUCCESS
QUIT
+96 KILL SUBFDA
+97 MERGE SUBFDA(SUBFILE)=FDB(SUBFILE)
+98 DO FILE^DIE("K","SUBFDA","DGCDERR")
+99 IF $GET(DIERR)
Begin DoDot:3
+100 SET ERROR=ERROR_" #"_SUBFILE
+101 SET SUCCESS=0
+102 DO ERRDISP^DGENCDA1(SUBFILE)
End DoDot:3
End DoDot:2
IF 'SUCCESS
QUIT
+103 IF SUCCESS
SET ERROR=""
End DoDot:1
+104 DO CLEAN^DILF
+105 DO UNLOCK^DGENCDA1(DFN)
+106 QUIT SUCCESS
