DGENLCD1 ;ALB/CJM,Zoltan,JAN,TGH - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997
;;5.3;Registration;**121,232,387,850,894**;Aug 13,1993;Build 48
;
; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
;
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("DESCR")) 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("DESCR",ITEM)) Q:ITEM="" D
. S DGLINE=DGLINE+1
. D SET^DGENL1(DGARY,DGLINE,$J("CD Descriptor: ",25)_$$EXT^DGENCDU("DESCR",DGCDIS("DESCR",ITEM)),1,,,,,,.DGCNT)
Q
;
DISP(Y) ; Patch DG*5.3*850
;called from 2.396 and 2.397 output transform, input y, output y
N DFN,NODE,TYPE,LONG,OUTPUT,DDATE,IMPDATE,ICDVER
S DFN=$S($G(DA(1))'="":DA(1),$G(DFN)'="":DFN,1:"")
S NODE=$G(^DGEN(27.17,+Y,0)),LONG=$G(^DGEN(27.17,+Y,5))
S TYPE=$P(NODE,U,2)
I DFN="" Q $P(NODE,U,1)
;
S DDATE=$P($G(^DPT(DFN,.39)),"^",2) ;Date of decision
I $G(DGCDIS("DATE")) S DDATE=DGCDIS("DATE")
I DDATE="" S DDATE=DT
S IMPDATE=$P($$IMPDATE^DGPTIC10($G(CODESYS)),"^",1)
S ICDVER=$S(DDATE<IMPDATE:9,1:10)
I ICDVER=9 S OUTPUT=$P(NODE,U,4)_" "_$P(NODE,U,1)_$S($P(NODE,U,3)["CPT":" (CPT)",1:" (ICD-9-CM)")
I ICDVER=10 D
. I LONG'="" S OUTPUT=$P(NODE,U,4)_" "_LONG_$S(TYPE="D":" (ICD-10-CM)",1:" ICD-10-PCS")
. I LONG="" S OUTPUT=$P(NODE,U,4)_" "_$P(NODE,U,1)_$S(TYPE="D":" (ICD-10-CM)",1:" ICD-10-PCS")
Q OUTPUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENLCD1 3189 printed Oct 16, 2024@18:43:27 Page 2
DGENLCD1 ;ALB/CJM,Zoltan,JAN,TGH - Enrollment Catastrophic Disability- Build List Area;13 JUN 1997
+1 ;;5.3;Registration;**121,232,387,850,894**;Aug 13,1993;Build 48
+2 ;
+3 ; DG*5.3*894 - Enhance Catastrophic Disability to use Descriptors rather than Diagnoses/Procedures/Conditions.
+4 ;
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("DESCR"))
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("DESCR",ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+33 SET DGLINE=DGLINE+1
+34 DO SET^DGENL1(DGARY,DGLINE,$JUSTIFY("CD Descriptor: ",25)_$$EXT^DGENCDU("DESCR",DGCDIS("DESCR",ITEM)),1,,,,,,.DGCNT)
End DoDot:1
+35 QUIT
+36 ;
DISP(Y) ; Patch DG*5.3*850
+1 ;called from 2.396 and 2.397 output transform, input y, output y
+2 NEW DFN,NODE,TYPE,LONG,OUTPUT,DDATE,IMPDATE,ICDVER
+3 SET DFN=$SELECT($GET(DA(1))'="":DA(1),$GET(DFN)'="":DFN,1:"")
+4 SET NODE=$GET(^DGEN(27.17,+Y,0))
SET LONG=$GET(^DGEN(27.17,+Y,5))
+5 SET TYPE=$PIECE(NODE,U,2)
+6 IF DFN=""
QUIT $PIECE(NODE,U,1)
+7 ;
+8 ;Date of decision
SET DDATE=$PIECE($GET(^DPT(DFN,.39)),"^",2)
+9 IF $GET(DGCDIS("DATE"))
SET DDATE=DGCDIS("DATE")
+10 IF DDATE=""
SET DDATE=DT
+11 SET IMPDATE=$PIECE($$IMPDATE^DGPTIC10($GET(CODESYS)),"^",1)
+12 SET ICDVER=$SELECT(DDATE<IMPDATE:9,1:10)
+13 IF ICDVER=9
SET OUTPUT=$PIECE(NODE,U,4)_" "_$PIECE(NODE,U,1)_$SELECT($PIECE(NODE,U,3)["CPT":" (CPT)",1:" (ICD-9-CM)")
+14 IF ICDVER=10
Begin DoDot:1
+15 IF LONG'=""
SET OUTPUT=$PIECE(NODE,U,4)_" "_LONG_$SELECT(TYPE="D":" (ICD-10-CM)",1:" ICD-10-PCS")
+16 IF LONG=""
SET OUTPUT=$PIECE(NODE,U,4)_" "_$PIECE(NODE,U,1)_$SELECT(TYPE="D":" (ICD-10-CM)",1:" ICD-10-PCS")
End DoDot:1
+17 QUIT OUTPUT
