- 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,1104**;Aug 13,1993;Build 59
- ;
- 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)
- ;
- ;COMPACT Eligibility
- S DGLINE=DGLINE+1
- D SET(DGARY,DGLINE,"COMPACT Eligibility: "_$$ELIG^DGCOMPACTELIG(DFN,"DGENL1"),3,,,,,,.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 11200 printed Feb 19, 2025@00:08:48 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,1104**;Aug 13,1993;Build 59
- +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 ;COMPACT Eligibility
- +49 SET DGLINE=DGLINE+1
- +50 DO SET(DGARY,DGLINE,"COMPACT Eligibility: "_$$ELIG^DGCOMPACTELIG(DFN,"DGENL1"),3,,,,,,.DGCNT)
- +51 ;
- +52 ;Military retirement - new fields added with DG*5.3*672
- +53 SET DGLINE=DGLINE+1
- +54 SET DGRET=$GET(DGENR("ELIG","DISRET"))
- +55 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)
- +56 DO SET(DGARY,DGLINE,"Dischrg Due to Disab: "_$SELECT($GET(DGENR("ELIG","DISLOD"))'="":$$EXT^DGENU("DISLOD",DGENR("ELIG","DISLOD")),1:""),42,,,,,,.DGCNT)
- +57 ;
- +58 ;Combat Vet End Date (added for DG*5.3*564 - HVE Phase III)
- +59 SET DGLINE=DGLINE+1
- +60 DO SET(DGARY,DGLINE,"Combat Vet End Date: "_$SELECT($GET(DGENR("ELIG","CVELEDT"))'="":$$EXT^DGENU("CVELEDT",DGENR("ELIG","CVELEDT")),1:""),3,,,,,,.DGCNT)
- +61 ;
- +62 ;Eligible for medicaid
- +63 SET DGLINE=DGLINE+1
- +64 DO SET(DGARY,DGLINE,"Eligible for MEDICAID: "_$SELECT($GET(DGENR("ELIG","MEDICAID"))'="":$$EXT^DGENU("MEDICAID",DGENR("ELIG","MEDICAID")),1:""),1,,,,,,.DGCNT)
- +65 ;
- +66 ;Service connected and percentage
- +67 SET DGLINE=DGLINE+1
- +68 DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
- +69 SET DGLINE=DGLINE+1
- +70 DO SET(DGARY,DGLINE,"Svc Connected: "_$SELECT($GET(DGENR("ELIG","SC"))'="":$$EXT^DGENU("SC",DGENR("ELIG","SC")),1:""),9,,,,,,.DGCNT)
- +71 DO SET(DGARY,DGLINE,"SC Percent: "_$SELECT($GET(DGENR("ELIG","SCPER"))'="":$$EXT^DGENU("SCPER",DGENR("ELIG","SCPER"))_"%",1:""),52,,,,,,.DGCNT)
- +72 ;
- +73 ;Aid & attendance and housebound
- +74 SET DGLINE=DGLINE+1
- +75 DO SET(DGARY,DGLINE,"Aid & Attendance: "_$SELECT($GET(DGENR("ELIG","A&A"))'="":$$EXT^DGENU("A&A",DGENR("ELIG","A&A")),1:""),6,,,,,,.DGCNT)
- +76 DO SET(DGARY,DGLINE,"Housebound: "_$SELECT($GET(DGENR("ELIG","HB"))'="":$$EXT^DGENU("HB",DGENR("ELIG","HB")),1:""),52,,,,,,.DGCNT)
- +77 ;
- +78 ;VA Pension
- +79 ;Unemployable (added for DG*5.3*564 - HVE Phase III)
- +80 SET DGLINE=DGLINE+1
- +81 DO SET(DGARY,DGLINE,"VA Pension: "_$SELECT($GET(DGENR("ELIG","VAPEN"))'="":$$EXT^DGENU("VAPEN",DGENR("ELIG","VAPEN")),1:""),12,,,,,,.DGCNT)
- +82 DO SET(DGARY,DGLINE,"Unemployable: "_$SELECT($GET(DGENR("ELIG","UNEMPLOY"))'="":$$EXT^DGENU("UNEMPLOY",DGENR("ELIG","UNEMPLOY")),1:""),50,,,,,,.DGCNT)
- +83 ;
- +84 ;Total check amount
- +85 SET DGLINE=DGLINE+1
- +86 DO SET(DGARY,DGLINE,"Total Check Amount: "_$SELECT($GET(DGENR("ELIG","VACKAMT"))'="":$$EXT^DGENU("VACKAMT",DGENR("ELIG","VACKAMT")),1:""),4,,,,,,.DGCNT)
- +87 ;
- +88 ;PROJ 112/SHAD - DG*5.3*653
- +89 IF $GET(DGENR("ELIG","SHAD"))=1
- Begin DoDot:1
- +90 DO SET(DGARY,DGLINE,"Proj 112/SHAD: "_$$EXT^DGENU("SHAD",DGENR("ELIG","SHAD")),49,,,,,,.DGCNT)
- End DoDot:1
- +91 ;
- +92 ;Eligibility code
- +93 SET DGLINE=DGLINE+1
- +94 DO SET(DGARY,DGLINE,"Eligibility Code: "_$SELECT($GET(DGENR("ELIG","CODE"))'="":$$EXT^DGENU("CODE",DGENR("ELIG","CODE")),1:""),6,,,,,,.DGCNT)
- +95 ;
- +96 ;Means test
- +97 SET DGLINE=DGLINE+1
- +98 DO SET(DGARY,DGLINE,"Means Test Status: "_$SELECT($GET(DGENR("ELIG","MTSTA"))'="":$$EXT^DGENU("MTSTA",DGENR("ELIG","MTSTA")),1:""),5,,,,,,.DGCNT)
- +99 ;
- +100 ;Veteran Catastrophically Disabled
- +101 SET DGLINE=DGLINE+1
- +102 DO SET(DGARY,DGLINE,"Veteran CD Status: "_$SELECT($GET(DGENR("ELIG","VCD"))'="":$$EXT^DGENU("VCD",DGENR("ELIG","VCD")),1:""),5,,,,,,.DGCNT)
- +103 ;
- +104 ;Medal of Honor
- +105 SET DGLINE=DGLINE+1
- +106 ; get and display MOH fields DG*5.3*972 HM
- +107 NEW DGMOHADT,DGMOHSDT,DGMOHEDT,DGMOHIND
- +108 SET DGMOHIND=$GET(DGENR("ELIG","MOH"))
- SET DGMOHADT=$GET(DGENR("ELIG","MOHAWRDDATE"))
- SET DGMOHSDT=$GET(DGENR("ELIG","MOHSTATDATE"))
- SET DGMOHEDT=$GET(DGENR("ELIG","MOHEXEMPDATE"))
- +109 IF DGMOHIND="Y"
- IF DGMOHADT=""
- SET DGMOHADT="UNKNOWN"
- SET DGMOHEDT="Needs Determination"
- +110 SET DGMOHIND=$SELECT(DGMOHIND="Y":"YES",DGMOHIND="N":"NO",1:"")
- +111 DO SET(DGARY,DGLINE,"MOH Indicator: "_DGMOHIND,9,,,,,,.DGCNT)
- +112 ;MOH Award Date DG*5.3*972 HM
- DO SET(DGARY,DGLINE,"MOH Award Date: "_$$FMTE^XLFDT(DGMOHADT,"5DZ"),48,,,,,,.DGCNT)
- +113 SET DGLINE=DGLINE+1
- +114 ;MOH Status Date DG*5.3*972 HM
- DO SET(DGARY,DGLINE,"MOH Status Date: "_$$FMTE^XLFDT(DGMOHSDT,"5DZ"),7,,,,,,.DGCNT)
- +115 SET DGLINE=DGLINE+1
- +116 ;MOH Copayment Exemption Date DG*5.3*972 HM
- DO SET(DGARY,DGLINE,"MOH Copay Exemption Date: "_$$FMTE^XLFDT(DGMOHEDT,"5DZ"),1,,,,,,.DGCNT)
- +117 SET DGLINE=DGLINE+1
- +118 ;
- +119 ;Set line to start on next page
- +120 FOR DGLINE=DGLINE+1:1:DGSTART+VALM("LINES")
- DO SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
- +121 QUIT
- +122 ;
- 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 ""