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 Apr 09, 2024@21:50:13 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 ;
