DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM - 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,1015**;Aug 13,1993;Build 21
;
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)
; .396 CD STATUS DIAGNOSES field (multiple):
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)
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
S SITE=$$SITE^VASITE
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
;
DGENCDA ;ALB/CJM,Zoltan,JAN,BRM,TDM - 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,1015**;Aug 13,1993;Build 21
+2 ;
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 ; .396 CD STATUS DIAGNOSES field (multiple):
+38 SET SIEN=0
+39 FOR ITEM=1:1
SET SIEN=$ORDER(^DPT(DFN,.396,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+40 ; .01 CD STATUS DIAGNOSES sub-field.
+41 SET DGCDIS("DIAG",ITEM)=$PIECE($GET(^DPT(DFN,.396,SIEN,0)),"^",1)
End DoDot:1
+42 ; .397 CD STATUS PROCEDURES field (multiple):
+43 SET (ITEM,SITEM,SIEN)=0
+44 FOR
SET ITEM=$ORDER(^DPT(DFN,.397,"B",ITEM))
IF 'ITEM
QUIT
Begin DoDot:1
+45 SET IND=0
SET SIEN=SIEN+1
+46 FOR
SET SITEM=$ORDER(^DPT(DFN,.397,"B",ITEM,SITEM))
IF 'SITEM
QUIT
Begin DoDot:2
+47 ; .01 CD STATUS PROCEDURES sub-field.
+48 SET DGCDIS("PROC",SIEN)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",1)
+49 ; 1 AFFECTED EXTREMITY sub-field.
+50 SET DGCDIS("EXT",SIEN)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",2)
+51 SET IND=IND+1
SET DGCDIS("EXT",SIEN,IND)=$PIECE($GET(^DPT(DFN,.397,SITEM,0)),"^",2)
End DoDot:2
End DoDot:1
+52 ; - .398 CD STATUS CONDITIONS field (multiple):
+53 SET SIEN=0
+54 FOR ITEM=1:1
SET SIEN=$ORDER(^DPT(DFN,.398,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+55 ; .01 CD STATUS CONDITIONS sub-field.
+56 SET DGCDIS("COND",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",1)
+57 ; 1 SCORE sub-field.
+58 SET DGCDIS("SCORE",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",2)
+59 ; 2 PERMANENT INDICATOR sub-field.
+60 SET DGCDIS("PERM",ITEM)=$PIECE($GET(^DPT(DFN,.398,SIEN,0)),"^",3)
End DoDot:1
+61 QUIT 1
+62 ;
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
+10 SET SITE=$$SITE^VASITE
+11 IF $PIECE($GET(^DPT(DFN,.39)),"^",3)=$PIECE(SITE,"^")
QUIT 1
+12 QUIT "0^"_$PIECE($GET(^DPT(DFN,.39)),"^",3)
+13 ;
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 ;