DGENLCD1 ;ALB/CJM,Zoltan,JAN - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997 08:00 am,NOV 14 2001
;;5.3;Registration;**121,232,387,1015**;Aug 13,1993;Build 21
;
EN(DGARY,DFN,DGCNT) ;Entry point to build list area
; Input -- DGARY Global array subscript
; DFN Patient IEN
; Output -- DGCNT Number of lines in the list
N DGCDIS,DGLINE
I $$GET^DGENCDA(DFN,.DGCDIS) ;set-up catastrophic disability array
S DGLINE=1,DGCNT=0
D CD(DGARY,DFN,.DGCDIS,.DGLINE,.DGCNT)
Q
;
CD(DGARY,DFN,DGCDIS,DGLINE,DGCNT) ;
;Description: Writes Catastrophic Disabilty info to list.
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGCDIS Enrollment array
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N DGSTART,HASCAT,PERM
;
S DGSTART=DGLINE ; starting line number
D SET^DGENL1(DGARY,DGLINE," Catastrophic Disability ",28,IORVON,IORVOFF,,,,.DGCNT)
S DGLINE=DGLINE+2
S HASCAT=$$HASCAT^DGENCDA(DFN)
D SET^DGENL1(DGARY,DGLINE,$J("Veteran Catastrophically Disabled: ",41)_$S(HASCAT:"YES",1:"NO"),1,,,,,,.DGCNT)
;
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Date of Decision: ",41)_$$EXT^DGENCDU("DATE",DGCDIS("DATE")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Decided By: ",41)_$$EXT^DGENCDU("BY",DGCDIS("BY")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Facility Making Determination: ",41)_$$EXT^DGENCDU("FACDET",DGCDIS("FACDET")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Review Date: ",41)_$$EXT^DGENCDU("REVDTE",DGCDIS("REVDTE")),1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGENL1(DGARY,DGLINE,$J("Method of Determination: ",41)_$$EXT^DGENCDU("METDET",DGCDIS("METDET")),1,,,,,,.DGCNT)
;
; Display reasons for CD Determination.
I '$D(DGCDIS("DIAG")),'$D(DGCDIS("PROC")),'$D(DGCDIS("COND")) Q
S DGLINE=DGLINE+2
D SET^DGENL1(DGARY,DGLINE," Reason(s) for CD Determination ",24,IORVON,IORVOFF,,,,.DGCNT)
S DGLINE=DGLINE+1
S (ITEM,SUBITEM)=""
F S ITEM=$O(DGCDIS("DIAG",ITEM)) Q:ITEM="" D
. S DGLINE=DGLINE+1
. D SET^DGENL1(DGARY,DGLINE,$J("CD Status Diagnosis: ",25)_$$EXT^DGENCDU("DIAG",DGCDIS("DIAG",ITEM)),1,,,,,,.DGCNT)
F S ITEM=$O(DGCDIS("PROC",ITEM)) Q:ITEM="" D
. F S SUBITEM=$O(DGCDIS("EXT",ITEM,SUBITEM)) Q:SUBITEM="" D
. . S DGLINE=DGLINE+1
. . D SET^DGENL1(DGARY,DGLINE,$J("CD Status Procedure: ",25)_$$EXT^DGENCDU("PROC",DGCDIS("PROC",ITEM)),1,,,,,,.DGCNT)
. . S DGLINE=DGLINE+1
. . D SET^DGENL1(DGARY,DGLINE,$J("Affected Extremity: ",30)_$$EXT^DGENCDU("EXT",DGCDIS("EXT",ITEM,SUBITEM)),1,,,,,,.DGCNT)
F S ITEM=$O(DGCDIS("COND",ITEM)) Q:ITEM="" D
. S DGLINE=DGLINE+1
. D SET^DGENL1(DGARY,DGLINE,$J("CD Status Condition: ",25)_$$EXT^DGENCDU("COND",DGCDIS("COND",ITEM)),1,,,,,,.DGCNT)
. S DGLINE=DGLINE+1
. D SET^DGENL1(DGARY,DGLINE,$J("Score: ",30)_$$EXT^DGENCDU("SCORE",DGCDIS("SCORE",ITEM)),1,,,,,,.DGCNT)
. S DGLINE=DGLINE+1
. I '$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM),1) S PERM="N/A"
. E S PERM=$$EXT^DGENCDU("PERM",DGCDIS("PERM",ITEM))
. D SET^DGENL1(DGARY,DGLINE,$J("Permanent Indicator: ",30)_PERM,1,,,,,,.DGCNT)
;
Q
DGENLCD1 ;ALB/CJM,Zoltan,JAN - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997 08:00 am,NOV 14 2001
+1 ;;5.3;Registration;**121,232,387,1015**;Aug 13,1993;Build 21
+2 ;
EN(DGARY,DFN,DGCNT) ;Entry point to build list area
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; Output -- DGCNT Number of lines in the list
+4 NEW DGCDIS,DGLINE
+5 ;set-up catastrophic disability array
IF $$GET^DGENCDA(DFN,.DGCDIS)
+6 SET DGLINE=1
SET DGCNT=0
+7 DO CD(DGARY,DFN,.DGCDIS,.DGLINE,.DGCNT)
+8 QUIT
+9 ;
CD(DGARY,DFN,DGCDIS,DGLINE,DGCNT) ;
+1 ;Description: Writes Catastrophic Disabilty info to list.
+2 ; Input -- DGARY Global array subscript
+3 ; DFN Patient IEN
+4 ; DGCDIS Enrollment array
+5 ; DGLINE Line number
+6 ; Output -- DGCNT Number of lines in the list
+7 NEW DGSTART,HASCAT,PERM
+8 ;
+9 ; starting line number
SET DGSTART=DGLINE
+10 DO SET^DGENL1(DGARY,DGLINE," Catastrophic Disability ",28,IORVON,IORVOFF,,,,.DGCNT)
+11 SET DGLINE=DGLINE+2
+12 SET HASCAT=$$HASCAT^DGENCDA(DFN)
+13 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Veteran Catastrophically Disabled: ",41)_$SELECT(HASCAT:"YES",1:"NO"),1,,,,,,.DGCNT)
+14 ;
+15 SET DGLINE=DGLINE+1
+16 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Date of Decision: ",41)_$$EXT^DGENCDU("DATE",DGCDIS("DATE")),1,,,,,,.DGCNT)
+17 SET DGLINE=DGLINE+1
+18 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Decided By: ",41)_$$EXT^DGENCDU("BY",DGCDIS("BY")),1,,,,,,.DGCNT)
+19 SET DGLINE=DGLINE+1
+20 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Facility Making Determination: ",41)_$$EXT^DGENCDU("FACDET",DGCDIS("FACDET")),1,,,,,,.DGCNT)
+21 SET DGLINE=DGLINE+1
+22 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Review Date: ",41)_$$EXT^DGENCDU("REVDTE",DGCDIS("REVDTE")),1,,,,,,.DGCNT)
+23 SET DGLINE=DGLINE+1
+24 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Method of Determination: ",41)_$$EXT^DGENCDU("METDET",DGCDIS("METDET")),1,,,,,,.DGCNT)
+25 ;
+26 ; Display reasons for CD Determination.
+27 IF '$DATA(DGCDIS("DIAG"))
IF '$DATA(DGCDIS("PROC"))
IF '$DATA(DGCDIS("COND"))
QUIT
+28 SET DGLINE=DGLINE+2
+29 DO SET^DGENL1(DGARY,DGLINE," Reason(s) for CD Determination ",24,IORVON,IORVOFF,,,,.DGCNT)
+30 SET DGLINE=DGLINE+1
+31 SET (ITEM,SUBITEM)=""
+32 FOR
SET ITEM=$ORDER(DGCDIS("DIAG",ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+33 SET DGLINE=DGLINE+1
+34 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("CD Status Diagnosis: ",25)_$$EXT^DGENCDU("DIAG",DGCDIS("DIAG",ITEM)),1,,,,,,.DGCNT)
End DoDot:1
+35 FOR
SET ITEM=$ORDER(DGCDIS("PROC",ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+36 FOR
SET SUBITEM=$ORDER(DGCDIS("EXT",ITEM,SUBITEM))
IF SUBITEM=""
QUIT
Begin DoDot:2
+37 SET DGLINE=DGLINE+1
+38 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("CD Status Procedure: ",25)_$$EXT^DGENCDU("PROC",DGCDIS("PROC",ITEM)),1,,,,,,.DGCNT)
+39 SET DGLINE=DGLINE+1
+40 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Affected Extremity: ",30)_$$EXT^DGENCDU("EXT",DGCDIS("EXT",ITEM,SUBITEM)),1,,,,,,.DGCNT)
End DoDot:2
End DoDot:1
+41 FOR
SET ITEM=$ORDER(DGCDIS("COND",ITEM))
IF ITEM=""
QUIT
Begin DoDot:1
+42 SET DGLINE=DGLINE+1
+43 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("CD Status Condition: ",25)_$$EXT^DGENCDU("COND",DGCDIS("COND",ITEM)),1,,,,,,.DGCNT)
+44 SET DGLINE=DGLINE+1
+45 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Score: ",30)_$$EXT^DGENCDU("SCORE",DGCDIS("SCORE",ITEM)),1,,,,,,.DGCNT)
+46 SET DGLINE=DGLINE+1
+47 IF '$$RANGEMET^DGENA5(DGCDIS("COND",ITEM),DGCDIS("SCORE",ITEM),1)
SET PERM="N/A"
+48 IF '$TEST
SET PERM=$$EXT^DGENCDU("PERM",DGCDIS("PERM",ITEM))
+49 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("Permanent Indicator: ",30)_PERM,1,,,,,,.DGCNT)
End DoDot:1
+50 ;
+51 QUIT
