VistA-WorldVistAEHR/r/REGISTRATION-DGQE-DG-DPT-GR.../DGENLCD1.m

66 lines
3.1 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
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**;Aug 13,1993
;
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