Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGENL1

DGENL1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. EN(DGARY,DFN,DGENRIEN,DGCNT) ;Entry point to build list area
  1. ; for patient enrollment and patient enrollment history
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; DGENRIEN Enrollment IEN
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGENCAT,DGENR,DGLINE
  1. I DGENRIEN,$$GET^DGENA(DGENRIEN,.DGENR) ;set-up enrollment array
  1. S DGENCAT=$$CATEGORY^DGENA4(,$G(DGENR("STATUS"))) ;enrollment category
  1. S DGENCAT=$$EXTERNAL^DILFD(27.15,.02,"",DGENCAT)
  1. S DGLINE=1,DGCNT=0
  1. D ENR(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;enrollment
  1. D PF(DGARY,DFN,.DGENR,.DGLINE,.DGCNT) ;priority factors
  1. D HIS^DGENL2(DGARY,DFN,DGENRIEN,.DGLINE,.DGCNT) ;history
  1. Q
  1. ;
  1. ENR(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Enrollment
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; DGENR Enrollment array
  1. ; DGLINE Line number
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGSTART,DGSTUS,DGCHK
  1. S DGCHK=0
  1. S DGSTUS=$$STATUS^DGENA($G(DFN)) I DGSTUS=25 S DGCHK=1 ; If DGSTUS=25 patient is Register Only DG*5.3*993
  1. I $G(DGENR("STATUS"))=25 S DGCHK=1 ; If DGSTUS=25 patient is Register Only DG*5.3*993
  1. ;
  1. S DGSTART=DGLINE ; starting line number
  1. D SET(DGARY,DGLINE,"Enrollment",31,IORVON,IORVOFF,,,,.DGCNT)
  1. ;
  1. ;Enrollment Date
  1. S DGLINE=DGLINE+1
  1. ; If DGSTUS=25 patient is Register Only, dont display Enrollment Date DG*5.3*993
  1. I DGCHK=0 D SET(DGARY,DGLINE,"Enrollment Date: "_$S($G(DGENR("DATE")):$$EXT^DGENU("DATE",DGENR("DATE")),1:""),11,,,,,,.DGCNT)
  1. ;
  1. ;
  1. ;Enrollment End Date
  1. S DGLINE=DGLINE+1
  1. ; If DGSTUS=25 patient is Register Only, dont display Enrollment End Date DG*5.3*993
  1. I DGCHK=0 D SET(DGARY,DGLINE,"Enrollment End Date: "_$S($G(DGENR("END")):$$EXT^DGENU("END",DGENR("END")),1:""),7,,,,,,.DGCNT)
  1. ;
  1. ;
  1. ;Enrollment Application Date
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Application Date: "_$S($G(DGENR("APP")):$$EXT^DGENU("APP",DGENR("APP")),1:""),10,,,,,,.DGCNT)
  1. ;
  1. ;Source
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Source of Enrollment: "_$S($G(DGENR("SOURCE")):$$EXT^DGENU("SOURCE",DGENR("SOURCE")),1:""),6,,,,,,.DGCNT)
  1. ;
  1. ;Category
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Enrollment Category: "_DGENCAT,7,IORVON,IORVOFF,,,,.DGCNT)
  1. ;
  1. ;Status
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Enrollment Status: "_$S($G(DGENR("STATUS")):$$EXT^DGENU("STATUS",DGENR("STATUS")),1:""),9,,,,,,.DGCNT)
  1. ;
  1. ;Reason for Closed Application
  1. S DGLINE=DGLINE+1
  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
  1. ;
  1. ;Priority
  1. S DGLINE=DGLINE+1
  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)
  1. ;
  1. ;
  1. ;Effective date
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Effective Date: "_$S($G(DGENR("EFFDATE")):$$EXT^DGENU("EFFDATE",DGENR("EFFDATE")),1:""),12,,,,,,.DGCNT)
  1. ;
  1. ;Reason canceled/declined
  1. ; Removed blank line to fix format after screen header was increased
  1. ; to 3 lines (DG*5.3*838).
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Reason Canceled/Declined: "_$S($G(DGENR("REASON")):$$EXT^DGENU("REASON",DGENR("REASON")),1:""),2,,,,,,.DGCNT)
  1. ;
  1. ;Canceled/declined remarks
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Canceled/Declined Remarks: "_$S($G(DGENR("REASON"))'="":$$EXT^DGENU("REMARKS",DGENR("REMARKS")),1:""),1,,,,,,.DGCNT)
  1. ;
  1. ;Entered by
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Entered By: "_$S($G(DGENR("USER")):$$EXT^DGENU("USER",DGENR("USER")),1:""),16,,,,,,.DGCNT)
  1. ;
  1. ;Date/time entered
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Date/Time Entered: "_$S($G(DGENR("DATETIME")):$$EXT^DGENU("DATETIME",DGENR("DATETIME")),1:""),9,,,,,,.DGCNT)
  1. ;
  1. ;Set line to start on next page
  1. F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
  1. Q
  1. ;
  1. PF(DGARY,DFN,DGENR,DGLINE,DGCNT) ;Priority factors
  1. ; Input -- DGARY Global array subscript
  1. ; DFN Patient IEN
  1. ; DGENR Enrollment array
  1. ; DGLINE Line number
  1. ; Output -- DGCNT Number of lines in the list
  1. N DGSTART
  1. ;
  1. S DGSTART=DGLINE ; starting line number
  1. D SET(DGARY,DGLINE,"Priority Factors",31,IORVON,IORVOFF,,,,.DGCNT)
  1. ;
  1. ;POW
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"POW: "_$S($G(DGENR("ELIG","POW"))'="":$$EXT^DGENU("POW",DGENR("ELIG","POW")),1:""),19,,,,,,.DGCNT)
  1. ;
  1. ;Medal of Honor (DG*5.3*841) ;REMOVED DG*5.3*972 HM
  1. ;I $G(DGENR("ELIG","MOH"))="Y" D
  1. ;.D SET(DGARY,DGLINE,"Medal of Honor: YES",48,,,,,,.DGCNT)
  1. ;
  1. ;Purple Heart - added for patch 343;brm;10/23/00
  1. N PHDAT
  1. S DGLINE=DGLINE+1
  1. S PHDAT=$$PHEART(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
  1. D SET(DGARY,DGLINE,"Purple Hrt: "_$P(PHDAT,U),12,,,,,,.DGCNT)
  1. D:$P(PHDAT,U)="YES" SET(DGARY,DGLINE,"Status: "_$P(PHDAT,U,2),32,,,,,,.DGCNT)
  1. D:$P(PHDAT,U)="NO" SET(DGARY,DGLINE,"Remarks: "_$P(PHDAT,U,3),31,,,,,,.DGCNT)
  1. ;
  1. ;Agent orange
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"A/O Exp.: "_$S($G(DGENR("ELIG","AO"))'="":$$EXT^DGENU("AO",DGENR("ELIG","AO")),1:""),14,,,,,,.DGCNT)
  1. 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
  1. ;
  1. ;Ionizing radiation
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"ION Rad.: "_$S($G(DGENR("ELIG","IR"))'="":$$EXT^DGENU("IR",DGENR("ELIG","IR")),1:""),14,,,,,,.DGCNT)
  1. ;
  1. ;Radiation Exposure Method
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Rad Exp Method: "_$S($G(DGENR("ELIG","RADEXPM"))'="":$$EXT^DGENU("RADEXPM",DGENR("ELIG","RADEXPM")),1:""),8,,,,,,.DGCNT)
  1. ;
  1. ;SW Asia Conditions - name change from Env con DG*5.3*688
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"SW Asia Cond: "_$S($G(DGENR("ELIG","EC"))'="":$$EXT^DGENU("EC",DGENR("ELIG","EC")),1:""),10,,,,,,.DGCNT)
  1. ;
  1. ;Camp Lejeune Eligibility Indicator - new fields added with DG*5.3*909
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Camp Lejeune: "_$S($G(DGENR("ELIG","CLE"))'="":$$EXT^DGENU("CLE",DGENR("ELIG","CLE")),1:""),10,,,,,,.DGCNT)
  1. ;
  1. ;COMPACT Eligibility
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"COMPACT Eligibility: "_$$ELIG^DGCOMPACTELIG(DFN,"DGENL1"),3,,,,,,.DGCNT)
  1. ;
  1. ;Military retirement - new fields added with DG*5.3*672
  1. S DGLINE=DGLINE+1
  1. S DGRET=$G(DGENR("ELIG","DISRET"))
  1. 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)
  1. D SET(DGARY,DGLINE,"Dischrg Due to Disab: "_$S($G(DGENR("ELIG","DISLOD"))'="":$$EXT^DGENU("DISLOD",DGENR("ELIG","DISLOD")),1:""),42,,,,,,.DGCNT)
  1. ;
  1. ;Combat Vet End Date (added for DG*5.3*564 - HVE Phase III)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Combat Vet End Date: "_$S($G(DGENR("ELIG","CVELEDT"))'="":$$EXT^DGENU("CVELEDT",DGENR("ELIG","CVELEDT")),1:""),3,,,,,,.DGCNT)
  1. ;
  1. ;Eligible for medicaid
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Eligible for MEDICAID: "_$S($G(DGENR("ELIG","MEDICAID"))'="":$$EXT^DGENU("MEDICAID",DGENR("ELIG","MEDICAID")),1:""),1,,,,,,.DGCNT)
  1. ;
  1. ;Service connected and percentage
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Svc Connected: "_$S($G(DGENR("ELIG","SC"))'="":$$EXT^DGENU("SC",DGENR("ELIG","SC")),1:""),9,,,,,,.DGCNT)
  1. D SET(DGARY,DGLINE,"SC Percent: "_$S($G(DGENR("ELIG","SCPER"))'="":$$EXT^DGENU("SCPER",DGENR("ELIG","SCPER"))_"%",1:""),52,,,,,,.DGCNT)
  1. ;
  1. ;Aid & attendance and housebound
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Aid & Attendance: "_$S($G(DGENR("ELIG","A&A"))'="":$$EXT^DGENU("A&A",DGENR("ELIG","A&A")),1:""),6,,,,,,.DGCNT)
  1. D SET(DGARY,DGLINE,"Housebound: "_$S($G(DGENR("ELIG","HB"))'="":$$EXT^DGENU("HB",DGENR("ELIG","HB")),1:""),52,,,,,,.DGCNT)
  1. ;
  1. ;VA Pension
  1. ;Unemployable (added for DG*5.3*564 - HVE Phase III)
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"VA Pension: "_$S($G(DGENR("ELIG","VAPEN"))'="":$$EXT^DGENU("VAPEN",DGENR("ELIG","VAPEN")),1:""),12,,,,,,.DGCNT)
  1. D SET(DGARY,DGLINE,"Unemployable: "_$S($G(DGENR("ELIG","UNEMPLOY"))'="":$$EXT^DGENU("UNEMPLOY",DGENR("ELIG","UNEMPLOY")),1:""),50,,,,,,.DGCNT)
  1. ;
  1. ;Total check amount
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Total Check Amount: "_$S($G(DGENR("ELIG","VACKAMT"))'="":$$EXT^DGENU("VACKAMT",DGENR("ELIG","VACKAMT")),1:""),4,,,,,,.DGCNT)
  1. ;
  1. ;PROJ 112/SHAD - DG*5.3*653
  1. I $G(DGENR("ELIG","SHAD"))=1 D
  1. .D SET(DGARY,DGLINE,"Proj 112/SHAD: "_$$EXT^DGENU("SHAD",DGENR("ELIG","SHAD")),49,,,,,,.DGCNT)
  1. ;
  1. ;Eligibility code
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Eligibility Code: "_$S($G(DGENR("ELIG","CODE"))'="":$$EXT^DGENU("CODE",DGENR("ELIG","CODE")),1:""),6,,,,,,.DGCNT)
  1. ;
  1. ;Means test
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Means Test Status: "_$S($G(DGENR("ELIG","MTSTA"))'="":$$EXT^DGENU("MTSTA",DGENR("ELIG","MTSTA")),1:""),5,,,,,,.DGCNT)
  1. ;
  1. ;Veteran Catastrophically Disabled
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"Veteran CD Status: "_$S($G(DGENR("ELIG","VCD"))'="":$$EXT^DGENU("VCD",DGENR("ELIG","VCD")),1:""),5,,,,,,.DGCNT)
  1. ;
  1. ;Medal of Honor
  1. S DGLINE=DGLINE+1
  1. ; get and display MOH fields DG*5.3*972 HM
  1. N DGMOHADT,DGMOHSDT,DGMOHEDT,DGMOHIND
  1. S DGMOHIND=$G(DGENR("ELIG","MOH")),DGMOHADT=$G(DGENR("ELIG","MOHAWRDDATE")),DGMOHSDT=$G(DGENR("ELIG","MOHSTATDATE")),DGMOHEDT=$G(DGENR("ELIG","MOHEXEMPDATE"))
  1. I DGMOHIND="Y",DGMOHADT="" S DGMOHADT="UNKNOWN",DGMOHEDT="Needs Determination"
  1. S DGMOHIND=$S(DGMOHIND="Y":"YES",DGMOHIND="N":"NO",1:"")
  1. D SET(DGARY,DGLINE,"MOH Indicator: "_DGMOHIND,9,,,,,,.DGCNT)
  1. D SET(DGARY,DGLINE,"MOH Award Date: "_$$FMTE^XLFDT(DGMOHADT,"5DZ"),48,,,,,,.DGCNT) ;MOH Award Date DG*5.3*972 HM
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"MOH Status Date: "_$$FMTE^XLFDT(DGMOHSDT,"5DZ"),7,,,,,,.DGCNT) ;MOH Status Date DG*5.3*972 HM
  1. S DGLINE=DGLINE+1
  1. D SET(DGARY,DGLINE,"MOH Copay Exemption Date: "_$$FMTE^XLFDT(DGMOHEDT,"5DZ"),1,,,,,,.DGCNT) ;MOH Copayment Exemption Date DG*5.3*972 HM
  1. S DGLINE=DGLINE+1
  1. ;
  1. ;Set line to start on next page
  1. F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET(DGARY,DGLINE,"",1,,,,,,.DGCNT)
  1. Q
  1. ;
  1. SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,DGCNT) ; moved to
  1. ;DGENL2 as DGENL1 was getting too big
  1. I $G(DGCOL)']"" S DGCOL=""
  1. I $G(DGON)']"" S DGON=""
  1. I $G(DGOFF)']"" S DGOFF=""
  1. I $G(DGSUB)']"" S DGSUB=""
  1. I $G(DGNUM)']"" S DGNUM=""
  1. I $G(DGDATA)']"" S DGDATA=""
  1. D SET^DGENL2(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGSUB,DGNUM,DGDATA,.DGCNT)
  1. Q
  1. PHEART(DFN,DGENRIEN,PHENRDT) ;move to DGENL2
  1. N PHI,PHST,PHRR,PHDAT
  1. S PHDAT=$$PHEART^DGENL2(DFN,$G(DGENRIEN),$G(DGENR("DATETIME")))
  1. S PHI=$P(PHDAT,U),PHST=$P(PHDAT,U,2),PHRR=$P(PHDAT,U,3)
  1. I ($G(PHI)]""!($G(PHST)]"")!($G(PHRR)]"")) Q $G(PHI)_"^"_$G(PHST)_"^"_$G(PHRR)
  1. Q ""