Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENCDA2

DGENCDA2.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
  1. ;
  1. STORE(DFN,DGCDIS,ERROR) ;
  1. ;Description: Creates a catastrophic disability record for a patient.
  1. ; Attempts to add catastrophically disabled eligibility code.
  1. ;Input:
  1. ; DFN - Patient IEN
  1. ; DGCDIS - the catastrophic disability array, passed by reference
  1. ;Output:
  1. ; Function Value - returns 1 if successful, otherwise 0
  1. ; ERROR - if not successful, an error message is returned,pass
  1. ; by reference
  1. N SUCCESS,FDA,SUB,HIEN,HSUB,FDB,NIEN,EIEN,DGCDERR
  1. S SUCCESS=1
  1. S ERROR=""
  1. I DGCDIS("VCD")="N" N I F I="BY","DATE","DTFACIRV","FACDET","METDET","REVDTE","VETREQDT" S DGCD(I)="" ; DG*5.3*894
  1. D ;drops out if invalid condition found
  1. . I $G(DFN),$D(^DPT(DFN,0))
  1. . E S SUCCESS=0,ERROR="PATIENT NOT FOUND" Q
  1. . I '$$LOCK^DGENCDA1(DFN) S SUCCESS=0,ERROR="RECORD IN USE, CAN NOT BE EDITED" Q
  1. . I '$$CHECK^DGENCDA1(.DGCDIS,.ERROR) S SUCCESS=0 Q
  1. . S HIEN=$P($G(^DPT(DFN,.399,0)),"^",3)+1
  1. . S HIEN=HIEN_","_DFN_","
  1. . S FDA(2,DFN_",",.39)=DGCDIS("VCD")
  1. . S FDB(2.399,HIEN,.39)=DGCDIS("VCD")
  1. . S FDA(2,DFN_",",.391)=DGCDIS("BY")
  1. . S FDB(2.399,HIEN,.391)=DGCDIS("BY")
  1. . S FDA(2,DFN_",",.392)=DGCDIS("DATE")
  1. . S FDB(2.399,HIEN,.392)=DGCDIS("DATE")
  1. . S FDA(2,DFN_",",.393)=DGCDIS("FACDET")
  1. . S FDB(2.399,HIEN,.393)=DGCDIS("FACDET")
  1. . S FDA(2,DFN_",",.394)=DGCDIS("REVDTE")
  1. . S FDB(2.399,HIEN,.394)=DGCDIS("REVDTE")
  1. . S FDA(2,DFN_",",.395)=DGCDIS("METDET")
  1. . S FDB(2.399,HIEN,.395)=DGCDIS("METDET")
  1. . S FDA(2,DFN_",",.3951)=DGCDIS("VETREQDT")
  1. . S FDB(2.399,HIEN,.3951)=DGCDIS("VETREQDT")
  1. . S FDA(2,DFN_",",.3952)=DGCDIS("DTFACIRV")
  1. . S FDB(2.399,HIEN,.3952)=DGCDIS("DTFACIRV")
  1. . S FDA(2,DFN_",",.3953)=DGCDIS("DTVETNOT")
  1. . S FDB(2.399,HIEN,.3953)=DGCDIS("DTVETNOT")
  1. . S SUB="",HSUB=0
  1. . S NIEN=0 F S SUB=$O(DGCDIS("DESCR",SUB)) Q:'SUB D
  1. . . I DGCDIS("DESCR",SUB)="" Q
  1. . . S NIEN=NIEN+1
  1. . . S FDB(2.401,NIEN_","_DFN_",",.01)=DGCDIS("DESCR",SUB)
  1. . . S HSUB=HSUB+1
  1. . . S FDB(2.409,HSUB_","_HIEN,.01)=DGCDIS("DESCR",SUB)
  1. . S FDB(2.399,HIEN,.01)=$$NOW^XLFDT
  1. I SUCCESS D
  1. . N SUBFDA,SUBFILE,IENS
  1. . S SUCCESS=$$DELETE^DGENCDA1(DFN)
  1. . Q:'SUCCESS
  1. . D UPDATE^DIE("","FDA","","DGCDERR")
  1. . I $G(DGCDERR) D Q
  1. . . S ERROR="FILEMAN UNABLE TO PERFORM UPDATE"
  1. . . S SUCCESS=0
  1. . . D ERRDISP^DGENCDA1(2)
  1. . S SUBFILE=""
  1. . S ERROR="FILEMAN UPDATE FAILED FOR "
  1. . F S SUBFILE=$O(FDB(SUBFILE)) Q:SUBFILE="" D Q:'SUCCESS
  1. . . N IEN,NODE,ITEM
  1. . . S IEN=""
  1. . . F ITEM=0:1 S IEN=$O(FDB(SUBFILE,IEN)) Q:'IEN D Q:'SUCCESS
  1. . . . N DIC,Y,DO,DD,DINUM,DA,NODE
  1. . . . I SUBFILE'=2.409 D
  1. . . . . S NODE=SUBFILE-2
  1. . . . . S DIC("P")=$P($G(^DD(2,SUBFILE-2,0)),"^",2)
  1. . . . . S DA(1)=DFN
  1. . . . E D
  1. . . . . S NODE=".399,"_$P(IEN,",",2)_",1"
  1. . . . . S DIC("P")=$P($G(^DD(2.399,.396,0)),"^",2)
  1. . . . . S DA(1)=$P(IEN,",",2),DA(2)=DFN
  1. . . . S DIC="^DPT("_DFN_","_NODE_","
  1. . . . S DIC(0)="L"
  1. . . . S X=FDB(SUBFILE,IEN,.01)
  1. . . . S DINUM=+IEN
  1. . . . D FILE^DICN
  1. . . . I Y=-1 S ERROR="FAILED TO ADD ENTRY TO #"_SUBFILE,SUCCESS=0
  1. . . Q:'SUCCESS
  1. . . K SUBFDA
  1. . . M SUBFDA(SUBFILE)=FDB(SUBFILE)
  1. . . D FILE^DIE("","SUBFDA","DGCDERR")
  1. . . I $G(DIERR) D
  1. . . . S ERROR=ERROR_" #"_SUBFILE
  1. . . . S SUCCESS=0
  1. . . . D ERRDISP^DGENCDA1(SUBFILE)
  1. . I SUCCESS S ERROR=""
  1. D CLEAN^DILF
  1. D UNLOCK^DGENCDA1(DFN)
  1. Q SUCCESS