- 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 Feb 19, 2025@00:08:32 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