- DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM,DJS - Catastrophic Disability API - Retrieve Data;May 24, 1999;Nov 14, 2001 ; 9/19/05 11:35am
- ;;5.3;Registration;**121,147,232,387,451,653,894,992**;Aug 13,1993;Build 5
- ;
- ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
- ;
- GET(DFN,DGCDIS) ;
- ;Description: Get catastrophic disability information for a patient
- ;Input:
- ; DFN - Patient IEN
- ;Output:
- ; DGCDIS - the catastrophic disability array, passed by reference
- ; subscripts:
- ; "BY" Decided By
- ; "DATE" Date of Decision
- ; "FACDET" Facility Making Determination
- ; "REVDTE" Review Date
- ; "VETREQDT" Date Veteran Requested CD Evaluation
- ; "DTFACIRV" Date Facility Initiated Review
- ; "DTVETNOT" Date Veteran Was Notified
- ;
- N SUB,ITEM,SITEM,SIEN,IND
- K DGCDIS S DGCDIS=""
- I '$G(DFN) D Q 0
- . F SUB="VCD","BY","DATE","FACDET","REVDTE","METDET","VETREQDT","DTFACIRV","DTVETNOT" S DGCDIS(SUB)=""
- ; .39 VETERAN CATASTROPHICALLY DISABLED? field.
- S DGCDIS("VCD")=$P($G(^DPT(DFN,.39)),"^",6)
- ; .391 DECIDED BY field.
- S DGCDIS("BY")=$P($G(^DPT(DFN,.39)),"^",1)
- ; .392 DATE OF DECISION field.
- S DGCDIS("DATE")=$P($G(^DPT(DFN,.39)),"^",2)
- ; .393 FACILITY MAKING DETERMINATION field.
- S DGCDIS("FACDET")=$P($G(^DPT(DFN,.39)),"^",3)
- ; .394 REVIEW DATE field.
- S DGCDIS("REVDTE")=$P($G(^DPT(DFN,.39)),"^",4)
- ; .395 METHOD OF DETERMINATION field.
- S DGCDIS("METDET")=$P($G(^DPT(DFN,.39)),"^",5)
- ; .3951 DATE VETERAN REQUESTED CD EVAL
- S DGCDIS("VETREQDT")=$P($G(^DPT(DFN,.39)),"^",7)
- ; .3952 DATE FACILITY INITIATED REVIEW
- S DGCDIS("DTFACIRV")=$P($G(^DPT(DFN,.39)),"^",8)
- ; .3953 DATE VETERAN WAS NOTIFIED
- S DGCDIS("DTVETNOT")=$P($G(^DPT(DFN,.39)),"^",9)
- S SIEN=0
- F ITEM=1:1 S SIEN=$O(^DPT(DFN,.396,SIEN)) Q:'SIEN D
- . ; .01 CD STATUS DIAGNOSES sub-field.
- . S DGCDIS("DIAG",ITEM)=$P($G(^DPT(DFN,.396,SIEN,0)),"^",1)
- ; .397 CD STATUS PROCEDURES field (multiple):
- S (ITEM,SITEM,SIEN)=0
- F S ITEM=$O(^DPT(DFN,.397,"B",ITEM)) Q:'ITEM D
- . S IND=0,SIEN=SIEN+1
- . F S SITEM=$O(^DPT(DFN,.397,"B",ITEM,SITEM)) Q:'SITEM D
- . . ; .01 CD STATUS PROCEDURES sub-field.
- . . S DGCDIS("PROC",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",1)
- . . ; 1 AFFECTED EXTREMITY sub-field.
- . . S DGCDIS("EXT",SIEN)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2)
- . . S IND=IND+1,DGCDIS("EXT",SIEN,IND)=$P($G(^DPT(DFN,.397,SITEM,0)),"^",2)
- ; - .398 CD STATUS CONDITIONS field (multiple):
- S SIEN=0
- F ITEM=1:1 S SIEN=$O(^DPT(DFN,.398,SIEN)) Q:'SIEN D
- . ; .01 CD STATUS CONDITIONS sub-field.
- . S DGCDIS("COND",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",1)
- . ; 1 SCORE sub-field.
- . S DGCDIS("SCORE",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",2)
- . ; 2 PERMANENT INDICATOR sub-field.
- . S DGCDIS("PERM",ITEM)=$P($G(^DPT(DFN,.398,SIEN,0)),"^",3)
- S SIEN=0
- F ITEM=1:1 S SIEN=$O(^DPT(DFN,.401,SIEN)) Q:'SIEN D ;DG*5.3*894
- . ; .401 CD DESCRIPTORS field (multiple):
- . S DGCDIS("DESCR",ITEM)=$P($G(^DPT(DFN,.401,SIEN,0)),"^",1)
- Q 1
- ;
- DISABLED(DFN) ;
- ;Description: Returns whether the patient is catastrophically disabled.
- ;
- ;Input:
- ; DFN - Patient IEN
- ;Output:
- ; Function Value - returns 1 if the patient is catastrophically
- ; disabled, otherwise 0
- ;
- Q $$HASCAT(DFN)
- ;
- HASCAT(DFN) ;
- ;Description: returns 1 if the patient is CATASTROPHICALLY DISABLED
- ;
- Q:'$G(DFN) 0
- Q $P($G(^DPT(DFN,.39)),"^",6)="Y"
- ;
- CHKSITE(DFN) ;is this the facility that made the CD determination?
- ;
- ;Input:
- ; DFN - Patient IEN
- ;Output:
- ; Function Value - returns 1 if CD evaluation was entered at local
- ; site, otherwise 0^SITE #
- ;
- Q:'$G(DFN) 0
- N SITE,DGDIV,DGSITE,DGSDIV
- S DGSITE=DUZ(2)
- S (DGDIV,DGSDIV)=0
- F S DGDIV=$O(^DG(40.8,DGDIV)) D Q:DGSDIV
- . I $P(^DG(40.8,DGDIV,0),"^",7)=DGSITE S DGSDIV=DGDIV
- S SITE=$$SITE^VASITE(,DGSDIV)
- Q:$P($G(^DPT(DFN,.39)),"^",3)=$P(SITE,"^") 1
- Q "0^"_$P($G(^DPT(DFN,.39)),"^",3)
- ;
- CDTYPE(DFN) ; Was the method of determination "Physical Exam"?
- ;
- ;Input:
- ; DFN - Patient IEN
- ;Output:
- ; Function Value - returns 1 if CD='Yes' & Method='Physical Exam'
- ; otherwise 0
- ;
- Q:'$G(DFN) 0
- Q:'$$HASCAT(DFN) 0
- Q $P($G(^DPT(DFN,.39)),"^",5)=3
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENCDA 4294 printed Feb 19, 2025@00:08:30 Page 2
- DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM,DJS - Catastrophic Disability API - Retrieve Data;May 24, 1999;Nov 14, 2001 ; 9/19/05 11:35am
- +1 ;;5.3;Registration;**121,147,232,387,451,653,894,992**;Aug 13,1993;Build 5
- +2 ;
- +3 ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
- +4 ;
- GET(DFN,DGCDIS) ;
- +1 ;Description: Get catastrophic disability information for a patient
- +2 ;Input:
- +3 ; DFN - Patient IEN
- +4 ;Output:
- +5 ; DGCDIS - the catastrophic disability array, passed by reference
- +6 ; subscripts:
- +7 ; "BY" Decided By
- +8 ; "DATE" Date of Decision
- +9 ; "FACDET" Facility Making Determination
- +10 ; "REVDTE" Review Date
- +11 ; "VETREQDT" Date Veteran Requested CD Evaluation
- +12 ; "DTFACIRV" Date Facility Initiated Review
- +13 ; "DTVETNOT" Date Veteran Was Notified
- +14 ;
- +15 NEW SUB,ITEM,SITEM,SIEN,IND
- +16 KILL DGCDIS
- SET DGCDIS=""
- +17 IF '$GET(DFN)
- Begin DoDot:1
- +18 FOR SUB="VCD","BY","DATE","FACDET","REVDTE","METDET","VETREQDT","DTFACIRV","DTVETNOT"
- SET DGCDIS(SUB)=""
- End DoDot:1
- QUIT 0
- +19 ; .39 VETERAN CATASTROPHICALLY DISABLED? field.
- +20 SET DGCDIS("VCD")=$PIECE($GET(^DPT(DFN,.39)),"^",6)
- +21 ; .391 DECIDED BY field.
- +22 SET DGCDIS("BY")=$PIECE($GET(^DPT(DFN,.39)),"^",1)
- +23 ; .392 DATE OF DECISION field.
- +24 SET DGCDIS("DATE")=$PIECE($GET(^DPT(DFN,.39)),"^",2)
- +25 ; .393 FACILITY MAKING DETERMINATION field.
- +26 SET DGCDIS("FACDET")=$PIECE($GET(^DPT(DFN,.39)),"^",3)
- +27 ; .394 REVIEW DATE field.
- +28 SET DGCDIS("REVDTE")=$PIECE($GET(^DPT(DFN,.39)),"^",4)
- +29 ; .395 METHOD OF DETERMINATION field.
- +30 SET DGCDIS("METDET")=$PIECE($GET(^DPT(DFN,.39)),"^",5)
- +31 ; .3951 DATE VETERAN REQUESTED CD EVAL
- +32 SET DGCDIS("VETREQDT")=$PIECE($GET(^DPT(DFN,.39)),"^",7)
- +33 ; .3952 DATE FACILITY INITIATED REVIEW
- +34 SET DGCDIS("DTFACIRV")=$PIECE($GET(^DPT(DFN,.39)),"^",8)
- +35 ; .3953 DATE VETERAN WAS NOTIFIED
- +36 SET DGCDIS("DTVETNOT")=$PIECE($GET(^DPT(DFN,.39)),"^",9)
- +37 SET SIEN=0
- +38 FOR ITEM=1:1
- SET SIEN=$ORDER(^DPT(DFN,.396,SIEN))
- if 'SIEN
- QUIT
- Begin DoDot:1
- +39 ; .01 CD STATUS DIAGNOSES sub-field.
- +40 SET DGCDIS("DIAG",ITEM)=$PIECE($GET(^DPT(DFN,.396,SIEN,0)),"^",1)
- End DoDot:1
- +41 ; .397 CD STATUS PROCEDURES field (multiple):
- +42 SET (ITEM,SITEM,SIEN)=0
- +43 FOR
- SET ITEM=$ORDER(^DPT(DFN,.397,"B",ITEM))
- if 'ITEM
- QUIT
- Begin DoDot:1
- +44 SET IND=0
- SET SIEN=SIEN+1
- +45 FOR
- SET SITEM=$ORDER(^DPT(DFN,.397,"B",ITEM,SITEM))
- if 'SITEM
- QUIT
- Begin DoDot:2
- +46 ; .01 CD STATUS PROCEDURES sub-field.
- +47 SET DGCDIS("PROC",SIEN)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",1)
- +48 ; 1 AFFECTED EXTREMITY sub-field.
- +49 SET DGCDIS("EXT",SIEN)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",2)
- +50 SET IND=IND+1
- SET DGCDIS("EXT",SIEN,IND)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",2)
- End DoDot:2
- End DoDot:1
- +51 ; - .398 CD STATUS CONDITIONS field (multiple):
- +52 SET SIEN=0
- +53 FOR ITEM=1:1
- SET SIEN=$ORDER(^DPT(DFN,.398,SIEN))
- if 'SIEN
- QUIT
- Begin DoDot:1
- +54 ; .01 CD STATUS CONDITIONS sub-field.
- +55 SET DGCDIS("COND",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",1)
- +56 ; 1 SCORE sub-field.
- +57 SET DGCDIS("SCORE",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",2)
- +58 ; 2 PERMANENT INDICATOR sub-field.
- +59 SET DGCDIS("PERM",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",3)
- End DoDot:1
- +60 SET SIEN=0
- +61 ;DG*5.3*894
- FOR ITEM=1:1
- SET SIEN=$ORDER(^DPT(DFN,.401,SIEN))
- if 'SIEN
- QUIT
- Begin DoDot:1
- +62 ; .401 CD DESCRIPTORS field (multiple):
- +63 SET DGCDIS("DESCR",ITEM)=$PIECE($GET(^DPT(DFN,.401,SIEN,0)),"^",1)
- End DoDot:1
- +64 QUIT 1
- +65 ;
- DISABLED(DFN) ;
- +1 ;Description: Returns whether the patient is catastrophically disabled.
- +2 ;
- +3 ;Input:
- +4 ; DFN - Patient IEN
- +5 ;Output:
- +6 ; Function Value - returns 1 if the patient is catastrophically
- +7 ; disabled, otherwise 0
- +8 ;
- +9 QUIT $$HASCAT(DFN)
- +10 ;
- HASCAT(DFN) ;
- +1 ;Description: returns 1 if the patient is CATASTROPHICALLY DISABLED
- +2 ;
- +3 if '$GET(DFN)
- QUIT 0
- +4 QUIT $PIECE($GET(^DPT(DFN,.39)),"^",6)="Y"
- +5 ;
- CHKSITE(DFN) ;is this the facility that made the CD determination?
- +1 ;
- +2 ;Input:
- +3 ; DFN - Patient IEN
- +4 ;Output:
- +5 ; Function Value - returns 1 if CD evaluation was entered at local
- +6 ; site, otherwise 0^SITE #
- +7 ;
- +8 if '$GET(DFN)
- QUIT 0
- +9 NEW SITE,DGDIV,DGSITE,DGSDIV
- +10 SET DGSITE=DUZ(2)
- +11 SET (DGDIV,DGSDIV)=0
- +12 FOR
- SET DGDIV=$ORDER(^DG(40.8,DGDIV))
- Begin DoDot:1
- +13 IF $PIECE(^DG(40.8,DGDIV,0),"^",7)=DGSITE
- SET DGSDIV=DGDIV
- End DoDot:1
- if DGSDIV
- QUIT
- +14 SET SITE=$$SITE^VASITE(,DGSDIV)
- +15 if $PIECE($GET(^DPT(DFN,.39)),"^",3)=$PIECE(SITE,"^")
- QUIT 1
- +16 QUIT "0^"_$PIECE($GET(^DPT(DFN,.39)),"^",3)
- +17 ;
- CDTYPE(DFN) ; Was the method of determination "Physical Exam"?
- +1 ;
- +2 ;Input:
- +3 ; DFN - Patient IEN
- +4 ;Output:
- +5 ; Function Value - returns 1 if CD='Yes' & Method='Physical Exam'
- +6 ; otherwise 0
- +7 ;
- +8 if '$GET(DFN)
- QUIT 0
- +9 if '$$HASCAT(DFN)
- QUIT 0
- +10 QUIT $PIECE($GET(^DPT(DFN,.39)),"^",5)=3
- +11 ;