DGENL1 ;ALB/RMO,KWP,EZ,BRM,LBD,ERC,EG,CKN,BAJ,JLS,HM,RN,ARF - Patient Enrollment - Build List Area ;5/12/11 3:53pm
;;5.3;Registration;**121,147,232,266,343,564,672,659,653,688,838,841,909,940,972,993,1090**;Aug 13,1993;Build 16
;
EN(DGARY,DFN,DGENRIEN,DGCNT) ;Entry point to build list area
; for patient enrollment and patient enrollment history
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGENRIEN Enrollment IEN
; Output -- DGCNT Number of lines in the list
N DGENCAT,DGENR,DGLINE
I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array
S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
S DGLINE=1,DGCNT=0
D ENR(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;enrollment
D PF(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;priority factors
D HIS^DGENL2(DGARY,DFN,DGENRIEN,.DGLINE,.DGCNT) ;history
Q
;
ENR(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Enrollment
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGENR Enrollment array
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N DGSTART,DGSTUS,DGCHK
S DGCHK=0
S DGSTUS=$$STATUS^DGENA($G(DFN)) I DGSTUS=25 S DGCHK=1 ; If DGSTUS=25 patient is Register Only DG*5.3*993
I $G(DGENR("STATUS"))=25 S DGCHK=1 ; If DGSTUS=25 patient is Register Only DG*5.3*993
;
S DGSTART=DGLINE ; starting line number
D SET(DGARY,DGLINE,"Enrollment",31,IORVON,IORVOFF,,,,.DGCNT)
;
;Enrollment Date
S DGLINE=DGLINE+1
; If DGSTUS=25 patient is Register Only, dont display Enrollment Date DG*5.3*993
I DGCHK=0 D SET(DGARY,DGLINE,"Enrollment Date: "_$S($G(DGENR("DATE")):$$EXT^DGENU("DATE",DGENR("DATE")),1:""),11,,,,,,.DGCNT)
;
;
;Enrollment End Date
S DGLINE=DGLINE+1
; If DGSTUS=25 patient is Register Only, dont display Enrollment End Date DG*5.3*993
I DGCHK=0 D SET(DGARY,DGLINE,"Enrollment End Date: "_$S($G(DGENR("END")):$$EXT^DGENU("END",DGENR("END")),1:""),7,,,,,,.DGCNT)
;
;
;Enrollment Application Date
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Application Date: "_$S($G(DGENR("APP")):$$EXT^DGENU("APP",DGENR("APP")),1:""),10,,,,,,.DGCNT)
;
;Source
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Source of Enrollment: "_$S($G(DGENR("SOURCE")):$$EXT^DGENU("SOURCE",DGENR("SOURCE")),1:""),6,,,,,,.DGCNT)
;
;Category
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Enrollment Category: "_DGENCAT,7,IORVON,IORVOFF,,,,.DGCNT)
;
;Status
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Enrollment Status: "_$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:""),9,,,,,,.DGCNT)
;
;Reason for Closed Application
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Reason for Closed Application: "_$S($G(DGENR("RCODE")):$$EXT^DGENU("RCODE",DGENR("RCODE")),1:""),,,,,,,.DGCNT) ;DJE DG*5.3*940 - Closed Application - display reason - - RM#867190
;
;Priority
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Enrollment Priority: "_$S($G(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$S($G(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),7,,,,,,.DGCNT)
;
;
;Effective date
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Effective Date: "_$S($G(DGENR("EFFDATE")):$$EXT^DGENU("EFFDATE",DGENR("EFFDATE")),1:""),12,,,,,,.DGCNT)
;
;Reason canceled/declined
; Removed blank line to fix format after screen header was increased
; to 3 lines (DG*5.3*838).
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Reason Canceled/Declined: "_$S($G(DGENR("REASON")):$$EXT^DGENU("REASON",DGENR("REASON")),1:""),2,,,,,,.DGCNT)
;
;Canceled/declined remarks
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Canceled/Declined Remarks: "_$S($G(DGENR("REASON"))'="":$$EXT^DGENU("REMARKS",DGENR("REMARKS")),1:""),1,,,,,,.DGCNT)
;
;Entered by
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Entered By: "_$S($G(DGENR("USER")):$$EXT^DGENU("USER",DGENR("USER")),1:""),16,,,,,,.DGCNT)
;
;Date/time entered
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Date/Time Entered: "_$S($G(DGENR("DATETIME")):$$EXT^DGENU("DATETIME",DGENR("DATETIME")),1:""),9,,,,,,.DGCNT)
;
;Set line to start on next page
F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
Q
;
PF(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Priority factors
; Input -- DGARY Global array subscript
; DFN Patient IEN
; DGENR Enrollment array
; DGLINE Line number
; Output -- DGCNT Number of lines in the list
N DGSTART
;
S DGSTART=DGLINE ; starting line number
D SET(DGARY,DGLINE,"Priority Factors",31,IORVON,IORVOFF,,,,.DGCNT)
;
;POW
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"POW: "_$S($G(DGENR("ELIG","POW"))'="":$$EXT^DGENU("POW",DGENR("ELIG","POW")),1:""),19,,,,,,.DGCNT)
;
;Medal of Honor (DG*5.3*841) ;REMOVED DG*5.3*972 HM
;I $G(DGENR("ELIG","MOH"))="Y" D
;.D SET(DGARY,DGLINE,"Medal of Honor: YES",48,,,,,,.DGCNT)
;
;Purple Heart - added for patch 343;brm;10/23/00
N PHDAT
S DGLINE=DGLINE+1
S PHDAT=$$PHEART(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
D SET(DGARY,DGLINE,"Purple Hrt: "_$P(PHDAT,U),12,,,,,,.DGCNT)
D:$P(PHDAT,U)="YES" SET(DGARY,DGLINE,"Status: "_$P(PHDAT,U,2),32,,,,,,.DGCNT)
D:$P(PHDAT,U)="NO" SET(DGARY,DGLINE,"Remarks: "_$P(PHDAT,U,3),31,,,,,,.DGCNT)
;
;Agent orange
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"A/O Exp.: "_$S($G(DGENR("ELIG","AO"))'="":$$EXT^DGENU("AO",DGENR("ELIG","AO")),1:""),14,,,,,,.DGCNT)
D SET(DGARY,DGLINE,$S($G(DGENR("ELIG","AOEXPLOC"))'="":$$EXT^DGENU("AOEXPLOC",DGENR("ELIG","AOEXPLOC")),1:""),31,,,,,,.DGCNT) ;DG*5.3*1090 remove A/O Exp Loc: label and shift 17 to the left
;
;Ionizing radiation
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"ION Rad.: "_$S($G(DGENR("ELIG","IR"))'="":$$EXT^DGENU("IR",DGENR("ELIG","IR")),1:""),14,,,,,,.DGCNT)
;
;Radiation Exposure Method
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Rad Exp Method: "_$S($G(DGENR("ELIG","RADEXPM"))'="":$$EXT^DGENU("RADEXPM",DGENR("ELIG","RADEXPM")),1:""),8,,,,,,.DGCNT)
;
;SW Asia Conditions - name change from Env con DG*5.3*688
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"SW Asia Cond: "_$S($G(DGENR("ELIG","EC"))'="":$$EXT^DGENU("EC",DGENR("ELIG","EC")),1:""),10,,,,,,.DGCNT)
;
;Camp Lejeune Eligibility Indicator - new fields added with DG*5.3*909
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Camp Lejeune: "_$S($G(DGENR("ELIG","CLE"))'="":$$EXT^DGENU("CLE",DGENR("ELIG","CLE")),1:""),10,,,,,,.DGCNT)
;
;Military retirement - new fields added with DG*5.3*672
S DGLINE=DGLINE+1
S DGRET=$G(DGENR("ELIG","DISRET"))
D SET(DGARY,DGLINE,"Mil Disab Retirement: "_$S($G(DGRET)=0:"NO",$G(DGRET)=1:"YES",$G(DGRET)=2:"YES",$G(DGRET)=3:"UNK",1:""),2,,,,,,.DGCNT)
D SET(DGARY,DGLINE,"Dischrg Due to Disab: "_$S($G(DGENR("ELIG","DISLOD"))'="":$$EXT^DGENU("DISLOD",DGENR("ELIG","DISLOD")),1:""),42,,,,,,.DGCNT)
;
;Combat Vet End Date (added for DG*5.3*564 - HVE Phase III)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Combat Vet End Date: "_$S($G(DGENR("ELIG","CVELEDT"))'="":$$EXT^DGENU("CVELEDT",DGENR("ELIG","CVELEDT")),1:""),3,,,,,,.DGCNT)
;
;Eligible for medicaid
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Eligible for MEDICAID: "_$S($G(DGENR("ELIG","MEDICAID"))'="":$$EXT^DGENU("MEDICAID",DGENR("ELIG","MEDICAID")),1:""),1,,,,,,.DGCNT)
;
;Service connected and percentage
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Svc Connected: "_$S($G(DGENR("ELIG","SC"))'="":$$EXT^DGENU("SC",DGENR("ELIG","SC")),1:""),9,,,,,,.DGCNT)
D SET(DGARY,DGLINE,"SC Percent: "_$S($G(DGENR("ELIG","SCPER"))'="":$$EXT^DGENU("SCPER",DGENR("ELIG","SCPER"))_"%",1:""),52,,,,,,.DGCNT)
;
;Aid & attendance and housebound
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Aid & Attendance: "_$S($G(DGENR("ELIG","A&A"))'="":$$EXT^DGENU("A&A",DGENR("ELIG","A&A")),1:""),6,,,,,,.DGCNT)
D SET(DGARY,DGLINE,"Housebound: "_$S($G(DGENR("ELIG","HB"))'="":$$EXT^DGENU("HB",DGENR("ELIG","HB")),1:""),52,,,,,,.DGCNT)
;
;VA Pension
;Unemployable (added for DG*5.3*564 - HVE Phase III)
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"VA Pension: "_$S($G(DGENR("ELIG","VAPEN"))'="":$$EXT^DGENU("VAPEN",DGENR("ELIG","VAPEN")),1:""),12,,,,,,.DGCNT)
D SET(DGARY,DGLINE,"Unemployable: "_$S($G(DGENR("ELIG","UNEMPLOY"))'="":$$EXT^DGENU("UNEMPLOY",DGENR("ELIG","UNEMPLOY")),1:""),50,,,,,,.DGCNT)
;
;Total check amount
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Total Check Amount: "_$S($G(DGENR("ELIG","VACKAMT"))'="":$$EXT^DGENU("VACKAMT",DGENR("ELIG","VACKAMT")),1:""),4,,,,,,.DGCNT)
;
;PROJ 112/SHAD - DG*5.3*653
I $G(DGENR("ELIG","SHAD"))=1 D
.D SET(DGARY,DGLINE,"Proj 112/SHAD: "_$$EXT^DGENU("SHAD",DGENR("ELIG","SHAD")),49,,,,,,.DGCNT)
;
;Eligibility code
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Eligibility Code: "_$S($G(DGENR("ELIG","CODE"))'="":$$EXT^DGENU("CODE",DGENR("ELIG","CODE")),1:""),6,,,,,,.DGCNT)
;
;Means test
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Means Test Status: "_$S($G(DGENR("ELIG","MTSTA"))'="":$$EXT^DGENU("MTSTA",DGENR("ELIG","MTSTA")),1:""),5,,,,,,.DGCNT)
;
;Veteran Catastrophically Disabled
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"Veteran CD Status: "_$S($G(DGENR("ELIG","VCD"))'="":$$EXT^DGENU("VCD",DGENR("ELIG","VCD")),1:""),5,,,,,,.DGCNT)
;
;Medal of Honor
S DGLINE=DGLINE+1
; get and display MOH fields DG*5.3*972 HM
N DGMOHADT,DGMOHSDT,DGMOHEDT,DGMOHIND
S DGMOHIND=$G(DGENR("ELIG","MOH")),DGMOHADT=$G(DGENR("ELIG","MOHAWRDDATE")),DGMOHSDT=$G(DGENR("ELIG","MOHSTATDATE")),DGMOHEDT=$G(DGENR("ELIG","MOHEXEMPDATE"))
I DGMOHIND="Y",DGMOHADT="" S DGMOHADT="UNKNOWN",DGMOHEDT="Needs Determination"
S DGMOHIND=$S(DGMOHIND="Y":"YES",DGMOHIND="N":"NO",1:"")
D SET(DGARY,DGLINE,"MOH Indicator: "_DGMOHIND,9,,,,,,.DGCNT)
D SET(DGARY,DGLINE,"MOH Award Date: "_$$FMTE^XLFDT(DGMOHADT,"5DZ"),48,,,,,,.DGCNT) ;MOH Award Date DG*5.3*972 HM
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"MOH Status Date: "_$$FMTE^XLFDT(DGMOHSDT,"5DZ"),7,,,,,,.DGCNT) ;MOH Status Date DG*5.3*972 HM
S DGLINE=DGLINE+1
D SET(DGARY,DGLINE,"MOH Copay Exemption Date: "_$$FMTE^XLFDT(DGMOHEDT,"5DZ"),1,,,,,,.DGCNT) ;MOH Copayment Exemption Date DG*5.3*972 HM
S DGLINE=DGLINE+1
;
;Set line to start on next page
F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
Q
;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,DGCNT) ; moved to
;DGENL2 as DGENL1 was getting too big
I $G(DGCOL)']"" S DGCOL=""
I $G(DGON)']"" S DGON=""
I $G(DGOFF)']"" S DGOFF=""
I $G(DGSUB)']"" S DGSUB=""
I $G(DGNUM)']"" S DGNUM=""
I $G(DGDATA)']"" S DGDATA=""
D SET^DGENL2(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,.DGCNT)
Q
PHEART(DFN,DGENRIEN,PHENRDT) ;move to DGENL2
N PHI,PHST,PHRR,PHDAT
S PHDAT=$$PHEART^DGENL2(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
S PHI=$P(PHDAT,U),PHST=$P(PHDAT,U,2),PHRR=$P(PHDAT,U,3)
I ($G(PHI)]""!($G(PHST)]"")!($G(PHRR)]"")) Q $G(PHI)_"^"_$G(PHST)_"^"_$G(PHRR)
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENL1 11053 printed Apr 09, 2024@21:43:54 Page 2
DGENL1 ;ALB/RMO,KWP,EZ,BRM,LBD,ERC,EG,CKN,BAJ,JLS,HM,RN,ARF - Patient Enrollment - Build List Area ;5/12/11 3:53pm
+1 ;;5.3;Registration;**121,147,232,266,343,564,672,659,653,688,838,841,909,940,972,993,1090**;Aug 13,1993;Build 16
+2 ;
EN(DGARY,DFN,DGENRIEN,DGCNT) ;Entry point to build list area
+1 ; for patient enrollment and patient enrollment history
+2 ; Input -- DGARY Global array subscript
+3 ; DFN Patient IEN
+4 ; DGENRIEN Enrollment IEN
+5 ; Output -- DGCNT Number of lines in the list
+6 NEW DGENCAT,DGENR,DGLINE
+7 ;set-up enrollment array
IF DGENRIEN
IF $$GET^DGENA(DGENRIEN,.DGENR)
+8 ;enrollment category
SET DGENCAT=$$CATEGORY^DGENA4(,$GET(DGENR("STATUS")))
+9 SET DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
+10 SET DGLINE=1
SET DGCNT=0
+11 ;enrollment
DO ENR(DGARY,DFN,.DGENR,.DGLINE,.DGCNT)
+12 ;priority factors
DO PF(DGARY,DFN,.DGENR,.DGLINE,.DGCNT)
+13 ;history
DO HIS^DGENL2(DGARY,DFN,DGENRIEN,.DGLINE,.DGCNT)
+14 QUIT
+15 ;
ENR(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Enrollment
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGENR Enrollment array
+4 ; DGLINE Line number
+5 ; Output -- DGCNT Number of lines in the list
+6 NEW DGSTART,DGSTUS,DGCHK
+7 SET DGCHK=0
+8 ; If DGSTUS=25 patient is Register Only DG*5.3*993
SET DGSTUS=$$STATUS^DGENA($GET(DFN))
IF DGSTUS=25
SET DGCHK=1
+9 ; If DGSTUS=25 patient is Register Only DG*5.3*993
IF $GET(DGENR("STATUS"))=25
SET DGCHK=1
+10 ;
+11 ; starting line number
SET DGSTART=DGLINE
+12 DO SET(DGARY,DGLINE,"Enrollment",31,IORVON,IORVOFF,,,,.DGCNT)
+13 ;
+14 ;Enrollment Date
+15 SET DGLINE=DGLINE+1
+16 ; If DGSTUS=25 patient is Register Only, dont display Enrollment Date DG*5.3*993
+17 IF DGCHK=0
DO SET(DGARY,DGLINE,"Enrollment Date: "_$SELECT($GET(DGENR("DATE")):$$EXT^DGENU("DATE",DGENR("DATE")),1:""),11,,,,,,.DGCNT)
+18 ;
+19 ;
+20 ;Enrollment End Date
+21 SET DGLINE=DGLINE+1
+22 ; If DGSTUS=25 patient is Register Only, dont display Enrollment End Date DG*5.3*993
+23 IF DGCHK=0
DO SET(DGARY,DGLINE,"Enrollment End Date: "_$SELECT($GET(DGENR("END")):$$EXT^DGENU("END",DGENR("END")),1:""),7,,,,,,.DGCNT)
+24 ;
+25 ;
+26 ;Enrollment Application Date
+27 SET DGLINE=DGLINE+1
+28 DO SET(DGARY,DGLINE,"Application Date: "_$SELECT($GET(DGENR("APP")):$$EXT^DGENU("APP",DGENR("APP")),1:""),10,,,,,,.DGCNT)
+29 ;
+30 ;Source
+31 SET DGLINE=DGLINE+1
+32 DO SET(DGARY,DGLINE,"Source of Enrollment: "_$SELECT($GET(DGENR("SOURCE")):$$EXT^DGENU("SOURCE",DGENR("SOURCE")),1:""),6,,,,,,.DGCNT)
+33 ;
+34 ;Category
+35 SET DGLINE=DGLINE+1
+36 DO SET(DGARY,DGLINE,"Enrollment Category: "_DGENCAT,7,IORVON,IORVOFF,,,,.DGCNT)
+37 ;
+38 ;Status
+39 SET DGLINE=DGLINE+1
+40 DO SET(DGARY,DGLINE,"Enrollment Status: "_$SELECT($GET(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:""),9,,,,,,.DGCNT)
+41 ;
+42 ;Reason for Closed Application
+43 SET DGLINE=DGLINE+1
+44 ;DJE DG*5.3*940 - Closed Application - display reason - - RM#867190
DO SET(DGARY,DGLINE,"Reason for Closed Application: "_$SELECT($GET(DGENR("RCODE")):$$EXT^DGENU("RCODE",DGENR("RCODE")),1:""),,,,,,,.DGCNT)
+45 ;
+46 ;Priority
+47 SET DGLINE=DGLINE+1
+48 DO SET(DGARY,DGLINE,"Enrollment Priority: "_$SELECT($GET(DGENR("PRIORITY")):DGENR("PRIORITY"),1:"")_$SELECT($GET(DGENR("SUBGRP")):$$EXT^DGENU("SUBGRP",DGENR("SUBGRP")),1:""),7,,,,,,.DGCNT)
+49 ;
+50 ;
+51 ;Effective date
+52 SET DGLINE=DGLINE+1
+53 DO SET(DGARY,DGLINE,"Effective Date: "_$SELECT($GET(DGENR("EFFDATE")):$$EXT^DGENU("EFFDATE",DGENR("EFFDATE")),1:""),12,,,,,,.DGCNT)
+54 ;
+55 ;Reason canceled/declined
+56 ; Removed blank line to fix format after screen header was increased
+57 ; to 3 lines (DG*5.3*838).
+58 SET DGLINE=DGLINE+1
+59 DO SET(DGARY,DGLINE,"Reason Canceled/Declined: "_$SELECT($GET(DGENR("REASON")):$$EXT^DGENU("REASON",DGENR("REASON")),1:""),2,,,,,,.DGCNT)
+60 ;
+61 ;Canceled/declined remarks
+62 SET DGLINE=DGLINE+1
+63 DO SET(DGARY,DGLINE,"Canceled/Declined Remarks: "_$SELECT($GET(DGENR("REASON"))'="":$$EXT^DGENU("REMARKS",DGENR("REMARKS")),1:""),1,,,,,,.DGCNT)
+64 ;
+65 ;Entered by
+66 SET DGLINE=DGLINE+1
+67 DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
+68 SET DGLINE=DGLINE+1
+69 DO SET(DGARY,DGLINE,"Entered By: "_$SELECT($GET(DGENR("USER")):$$EXT^DGENU("USER",DGENR("USER")),1:""),16,,,,,,.DGCNT)
+70 ;
+71 ;Date/time entered
+72 SET DGLINE=DGLINE+1
+73 DO SET(DGARY,DGLINE,"Date/Time Entered: "_$SELECT($GET(DGENR("DATETIME")):$$EXT^DGENU("DATETIME",DGENR("DATETIME")),1:""),9,,,,,,.DGCNT)
+74 ;
+75 ;Set line to start on next page
+76 FOR DGLINE=DGLINE+1:1:DGSTART+VALM("LINES")
DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
+77 QUIT
+78 ;
PF(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Priority factors
+1 ; Input -- DGARY Global array subscript
+2 ; DFN Patient IEN
+3 ; DGENR Enrollment array
+4 ; DGLINE Line number
+5 ; Output -- DGCNT Number of lines in the list
+6 NEW DGSTART
+7 ;
+8 ; starting line number
SET DGSTART=DGLINE
+9 DO SET(DGARY,DGLINE,"Priority Factors",31,IORVON,IORVOFF,,,,.DGCNT)
+10 ;
+11 ;POW
+12 SET DGLINE=DGLINE+1
+13 DO SET(DGARY,DGLINE,"POW: "_$SELECT($GET(DGENR("ELIG","POW"))'="":$$EXT^DGENU("POW",DGENR("ELIG","POW")),1:""),19,,,,,,.DGCNT)
+14 ;
+15 ;Medal of Honor (DG*5.3*841) ;REMOVED DG*5.3*972 HM
+16 ;I $G(DGENR("ELIG","MOH"))="Y" D
+17 ;.D SET(DGARY,DGLINE,"Medal of Honor: YES",48,,,,,,.DGCNT)
+18 ;
+19 ;Purple Heart - added for patch 343;brm;10/23/00
+20 NEW PHDAT
+21 SET DGLINE=DGLINE+1
+22 SET PHDAT=$$PHEART(DFN,$GET(DGENRIEN),$GET(DGENR("DATETIME")))
+23 DO SET(DGARY,DGLINE,"Purple Hrt: "_$PIECE(PHDAT,U),12,,,,,,.DGCNT)
+24 if $PIECE(PHDAT,U)="YES"
DO SET(DGARY,DGLINE,"Status: "_$PIECE(PHDAT,U,2),32,,,,,,.DGCNT)
+25 if $PIECE(PHDAT,U)="NO"
DO SET(DGARY,DGLINE,"Remarks: "_$PIECE(PHDAT,U,3),31,,,,,,.DGCNT)
+26 ;
+27 ;Agent orange
+28 SET DGLINE=DGLINE+1
+29 DO SET(DGARY,DGLINE,"A/O Exp.: "_$SELECT($GET(DGENR("ELIG","AO"))'="":$$EXT^DGENU("AO",DGENR("ELIG","AO")),1:""),14,,,,,,.DGCNT)
+30 ;DG*5.3*1090 remove A/O Exp Loc: label and shift 17 to the left
DO SET(DGARY,DGLINE,$SELECT($GET(DGENR("ELIG","AOEXPLOC"))'="":$$EXT^DGENU("AOEXPLOC",DGENR("ELIG","AOEXPLOC")),1:""),31,,,,,,.DGCNT)
+31 ;
+32 ;Ionizing radiation
+33 SET DGLINE=DGLINE+1
+34 DO SET(DGARY,DGLINE,"ION Rad.: "_$SELECT($GET(DGENR("ELIG","IR"))'="":$$EXT^DGENU("IR",DGENR("ELIG","IR")),1:""),14,,,,,,.DGCNT)
+35 ;
+36 ;Radiation Exposure Method
+37 SET DGLINE=DGLINE+1
+38 DO SET(DGARY,DGLINE,"Rad Exp Method: "_$SELECT($GET(DGENR("ELIG","RADEXPM"))'="":$$EXT^DGENU("RADEXPM",DGENR("ELIG","RADEXPM")),1:""),8,,,,,,.DGCNT)
+39 ;
+40 ;SW Asia Conditions - name change from Env con DG*5.3*688
+41 SET DGLINE=DGLINE+1
+42 DO SET(DGARY,DGLINE,"SW Asia Cond: "_$SELECT($GET(DGENR("ELIG","EC"))'="":$$EXT^DGENU("EC",DGENR("ELIG","EC")),1:""),10,,,,,,.DGCNT)
+43 ;
+44 ;Camp Lejeune Eligibility Indicator - new fields added with DG*5.3*909
+45 SET DGLINE=DGLINE+1
+46 DO SET(DGARY,DGLINE,"Camp Lejeune: "_$SELECT($GET(DGENR("ELIG","CLE"))'="":$$EXT^DGENU("CLE",DGENR("ELIG","CLE")),1:""),10,,,,,,.DGCNT)
+47 ;
+48 ;Military retirement - new fields added with DG*5.3*672
+49 SET DGLINE=DGLINE+1
+50 SET DGRET=$GET(DGENR("ELIG","DISRET"))
+51 DO SET(DGARY,DGLINE,"Mil Disab Retirement: "_$SELECT($GET(DGRET)=0:"NO",$GET(DGRET)=1:"YES",$GET(DGRET)=2:"YES",$GET(DGRET)=3:"UNK",1:""),2,,,,,,.DGCNT)
+52 DO SET(DGARY,DGLINE,"Dischrg Due to Disab: "_$SELECT($GET(DGENR("ELIG","DISLOD"))'="":$$EXT^DGENU("DISLOD",DGENR("ELIG","DISLOD")),1:""),42,,,,,,.DGCNT)
+53 ;
+54 ;Combat Vet End Date (added for DG*5.3*564 - HVE Phase III)
+55 SET DGLINE=DGLINE+1
+56 DO SET(DGARY,DGLINE,"Combat Vet End Date: "_$SELECT($GET(DGENR("ELIG","CVELEDT"))'="":$$EXT^DGENU("CVELEDT",DGENR("ELIG","CVELEDT")),1:""),3,,,,,,.DGCNT)
+57 ;
+58 ;Eligible for medicaid
+59 SET DGLINE=DGLINE+1
+60 DO SET(DGARY,DGLINE,"Eligible for MEDICAID: "_$SELECT($GET(DGENR("ELIG","MEDICAID"))'="":$$EXT^DGENU("MEDICAID",DGENR("ELIG","MEDICAID")),1:""),1,,,,,,.DGCNT)
+61 ;
+62 ;Service connected and percentage
+63 SET DGLINE=DGLINE+1
+64 DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
+65 SET DGLINE=DGLINE+1
+66 DO SET(DGARY,DGLINE,"Svc Connected: "_$SELECT($GET(DGENR("ELIG","SC"))'="":$$EXT^DGENU("SC",DGENR("ELIG","SC")),1:""),9,,,,,,.DGCNT)
+67 DO SET(DGARY,DGLINE,"SC Percent: "_$SELECT($GET(DGENR("ELIG","SCPER"))'="":$$EXT^DGENU("SCPER",DGENR("ELIG","SCPER"))_"%",1:""),52,,,,,,.DGCNT)
+68 ;
+69 ;Aid & attendance and housebound
+70 SET DGLINE=DGLINE+1
+71 DO SET(DGARY,DGLINE,"Aid & Attendance: "_$SELECT($GET(DGENR("ELIG","A&A"))'="":$$EXT^DGENU("A&A",DGENR("ELIG","A&A")),1:""),6,,,,,,.DGCNT)
+72 DO SET(DGARY,DGLINE,"Housebound: "_$SELECT($GET(DGENR("ELIG","HB"))'="":$$EXT^DGENU("HB",DGENR("ELIG","HB")),1:""),52,,,,,,.DGCNT)
+73 ;
+74 ;VA Pension
+75 ;Unemployable (added for DG*5.3*564 - HVE Phase III)
+76 SET DGLINE=DGLINE+1
+77 DO SET(DGARY,DGLINE,"VA Pension: "_$SELECT($GET(DGENR("ELIG","VAPEN"))'="":$$EXT^DGENU("VAPEN",DGENR("ELIG","VAPEN")),1:""),12,,,,,,.DGCNT)
+78 DO SET(DGARY,DGLINE,"Unemployable: "_$SELECT($GET(DGENR("ELIG","UNEMPLOY"))'="":$$EXT^DGENU("UNEMPLOY",DGENR("ELIG","UNEMPLOY")),1:""),50,,,,,,.DGCNT)
+79 ;
+80 ;Total check amount
+81 SET DGLINE=DGLINE+1
+82 DO SET(DGARY,DGLINE,"Total Check Amount: "_$SELECT($GET(DGENR("ELIG","VACKAMT"))'="":$$EXT^DGENU("VACKAMT",DGENR("ELIG","VACKAMT")),1:""),4,,,,,,.DGCNT)
+83 ;
+84 ;PROJ 112/SHAD - DG*5.3*653
+85 IF $GET(DGENR("ELIG","SHAD"))=1
Begin DoDot:1
+86 DO SET(DGARY,DGLINE,"Proj 112/SHAD: "_$$EXT^DGENU("SHAD",DGENR("ELIG","SHAD")),49,,,,,,.DGCNT)
End DoDot:1
+87 ;
+88 ;Eligibility code
+89 SET DGLINE=DGLINE+1
+90 DO SET(DGARY,DGLINE,"Eligibility Code: "_$SELECT($GET(DGENR("ELIG","CODE"))'="":$$EXT^DGENU("CODE",DGENR("ELIG","CODE")),1:""),6,,,,,,.DGCNT)
+91 ;
+92 ;Means test
+93 SET DGLINE=DGLINE+1
+94 DO SET(DGARY,DGLINE,"Means Test Status: "_$SELECT($GET(DGENR("ELIG","MTSTA"))'="":$$EXT^DGENU("MTSTA",DGENR("ELIG","MTSTA")),1:""),5,,,,,,.DGCNT)
+95 ;
+96 ;Veteran Catastrophically Disabled
+97 SET DGLINE=DGLINE+1
+98 DO SET(DGARY,DGLINE,"Veteran CD Status: "_$SELECT($GET(DGENR("ELIG","VCD"))'="":$$EXT^DGENU("VCD",DGENR("ELIG","VCD")),1:""),5,,,,,,.DGCNT)
+99 ;
+100 ;Medal of Honor
+101 SET DGLINE=DGLINE+1
+102 ; get and display MOH fields DG*5.3*972 HM
+103 NEW DGMOHADT,DGMOHSDT,DGMOHEDT,DGMOHIND
+104 SET DGMOHIND=$GET(DGENR("ELIG","MOH"))
SET DGMOHADT=$GET(DGENR("ELIG","MOHAWRDDATE"))
SET DGMOHSDT=$GET(DGENR("ELIG","MOHSTATDATE"))
SET DGMOHEDT=$GET(DGENR("ELIG","MOHEXEMPDATE"))
+105 IF DGMOHIND="Y"
IF DGMOHADT=""
SET DGMOHADT="UNKNOWN"
SET DGMOHEDT="Needs Determination"
+106 SET DGMOHIND=$SELECT(DGMOHIND="Y":"YES",DGMOHIND="N":"NO",1:"")
+107 DO SET(DGARY,DGLINE,"MOH Indicator: "_DGMOHIND,9,,,,,,.DGCNT)
+108 ;MOH Award Date DG*5.3*972 HM
DO SET(DGARY,DGLINE,"MOH Award Date: "_$$FMTE^XLFDT(DGMOHADT,"5DZ"),48,,,,,,.DGCNT)
+109 SET DGLINE=DGLINE+1
+110 ;MOH Status Date DG*5.3*972 HM
DO SET(DGARY,DGLINE,"MOH Status Date: "_$$FMTE^XLFDT(DGMOHSDT,"5DZ"),7,,,,,,.DGCNT)
+111 SET DGLINE=DGLINE+1
+112 ;MOH Copayment Exemption Date DG*5.3*972 HM
DO SET(DGARY,DGLINE,"MOH Copay Exemption Date: "_$$FMTE^XLFDT(DGMOHEDT,"5DZ"),1,,,,,,.DGCNT)
+113 SET DGLINE=DGLINE+1
+114 ;
+115 ;Set line to start on next page
+116 FOR DGLINE=DGLINE+1:1:DGSTART+VALM("LINES")
DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
+117 QUIT
+118 ;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,DGCNT) ; moved to
+1 ;DGENL2 as DGENL1 was getting too big
+2 IF $GET(DGCOL)']""
SET DGCOL=""
+3 IF $GET(DGON)']""
SET DGON=""
+4 IF $GET(DGOFF)']""
SET DGOFF=""
+5 IF $GET(DGSUB)']""
SET DGSUB=""
+6 IF $GET(DGNUM)']""
SET DGNUM=""
+7 IF $GET(DGDATA)']""
SET DGDATA=""
+8 DO SET^DGENL2(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,.DGCNT)
+9 QUIT
PHEART(DFN,DGENRIEN,PHENRDT) ;move to DGENL2
+1 NEW PHI,PHST,PHRR,PHDAT
+2 SET PHDAT=$$PHEART^DGENL2(DFN,$GET(DGENRIEN),$GET(DGENR("DATETIME")))
+3 SET PHI=$PIECE(PHDAT,U)
SET PHST=$PIECE(PHDAT,U,2)
SET PHRR=$PIECE(PHDAT,U,3)
+4 IF ($GET(PHI)]""!($GET(PHST)]"")!($GET(PHRR)]""))
QUIT $GET(PHI)_"^"_$GET(PHST)_"^"_$GET(PHRR)
+5 QUIT ""
