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

DGRPTL2.m

Go to the documentation of this file. 
  1. DGRPTL2 ;ALB/RMO - 10-10T Registration - Build List Area Cont.;26 DEC 1996 08:00 am ; 8/22/00 12:37pm
  1.  ;;5.3;Registration;**108,343**;Aug 13, 1993
  1.  ;
  1. EN(DGARY,DFN,DGLINE,DGCNT) ;Entry point to build list area cont.
  1.  ; Input  -- DGARY    Global array subscript
  1.  ;           DFN      Patient IEN
  1.  ;           DGLINE   Line number
  1.  ; Output -- DGCNT    Number of lines in the list
  1.  N C,DGRP,DGSTART,Y
  1.  ;
  1.  ;Military service
  1.  S DGSTART=DGLINE ;starting line number
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Military Service",31,.DGCNT,IORVON,IORVOFF)
  1.  ;
  1.  ;Service branch and number
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.32)=$G(^DPT(DFN,.32)) ;military service
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Service Branch [Last]: "_$S($D(^DIC(23,+$P(DGRP(.32),U,5),0)):$P(^(0),U,1),1:"UNANSWERED"),1,.DGCNT)
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Number [Last]: "_$S($P(DGRP(.32),U,8)'="":$P(DGRP(.32),U,8),1:"UNANSWERED"),49,.DGCNT)
  1.  ;
  1.  ;POW
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.52)=$G(^DPT(DFN,.52)) ;pow
  1.  S Y=$P(DGRP(.52),U,5),C=$P(^DD(2,.525,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"POW: "_Y,19,.DGCNT)
  1.  ;
  1.  ;Agent orange
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.321)=$G(^DPT(DFN,.321)) ;ao/ir exposure
  1.  S Y=$P(DGRP(.321),U,2),C=$P(^DD(2,.32102,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"A/O Exp.: "_Y,14,.DGCNT)
  1.  ;
  1.  ;Ionizing radiation
  1.  S DGLINE=DGLINE+1
  1.  S Y=$P(DGRP(.321),U,3),C=$P(^DD(2,.32103,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"ION Rad.: "_Y,14,.DGCNT)
  1.  ;
  1.  ;Environmental contaminants
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.322)=$G(^DPT(DFN,.322)) ;env contam exposure
  1.  S Y=$P(DGRP(.322),U,13),C=$P(^DD(2,.322013,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Env Contam: "_Y,12,.DGCNT)
  1.  ;
  1.  ;Military disability
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.36)=$G(^DPT(DFN,.36)) ;mil disab
  1.  S Y=$P(DGRP(.36),U,2),C=$P(^DD(2,.362,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Mil Disab: "_$S(Y'="":Y,1:"UNANSWERED"),13,.DGCNT)
  1.  ;
  1.  ;Purple Heart
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.53)=$G(^DPT(DFN,.53)) ;purple heart
  1.  S Y=$P(DGRP(.53),U,1),C=$P(^DD(2,.531,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Purple Heart: "_Y,10,.DGCNT)
  1.  ;
  1.  ;Eligibility
  1.  D ELG(DGARY,DFN,.DGLINE,.DGCNT) ;eligibility
  1.  ;
  1.  ;Set line to start on next page
  1.  F DGLINE=DGLINE+1:1:DGSTART+VALM("LINES") D SET^DGRPTL1(DGARY,DGLINE,"",1,.DGCNT)
  1.  Q
  1.  ;
  1. ELG(DGARY,DFN,DGLINE,DGCNT) ;Eligibility
  1.  ; Input  -- DGARY    Global array subscript
  1.  ;           DFN      Patient IEN
  1.  ;           DGLINE   Line number
  1.  ; Output -- DGCNT    Number of lines in the list
  1.  N C,DGRP,DGRPENM,Y
  1.  ;
  1.  ;Eligibility
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Eligibility",31,.DGCNT,IORVON,IORVOFF)
  1.  ;
  1.  ;Patient type and veteran
  1.  S DGLINE=DGLINE+1
  1.  S DGRP("TYPE")=$G(^DPT(DFN,"TYPE")) ;patient type
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Patient Type: "_$S($D(^DG(391,+DGRP("TYPE"),0)):$P(^(0),U,1),1:"UNANSWERED"),10,.DGCNT)
  1.  S DGRP("VET")=$G(^DPT(DFN,"VET")) ;veteran
  1.  S Y=$P(DGRP("VET"),U,1),C=$P(^DD(2,1901,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Veteran: "_$S(Y'="":Y,1:"UNANSWERED"),55,.DGCNT)
  1.  ;
  1.  ;Service connected and percentage
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.3)=$G(^DPT(DFN,.3)) ;service connected, percentage
  1.  S Y=$P(DGRP(.3),U,1),C=$P(^DD(2,.301,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Svc Connected: "_$S(Y'="":Y,1:"UNANSWERED"),9,.DGCNT)
  1.  D SET^DGRPTL1(DGARY,DGLINE,"SC Percent: "_$S($P(DGRP(.3),U,2)'="":+$P(DGRP(.3),U,2)_"%",$P(DGRP(.3),U,1)'="Y":"N/A",1:"UNANSWERED"),52,.DGCNT)
  1.  ;
  1.  ;Aid & attendance and housebound
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.362)=$G(^DPT(DFN,.362)) ;a&a, housebound, pension
  1.  S Y=$P(DGRP(.362),U,12),C=$P(^DD(2,.36205,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Aid & Attendance: "_$S(Y'="":Y,1:"UNANSWERED"),6,.DGCNT)
  1.  S Y=$P(DGRP(.362),U,13),C=$P(^DD(2,.36215,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Housebound: "_$S(Y'="":Y,1:"UNANSWERED"),52,.DGCNT)
  1.  ;
  1.  ;VA pension
  1.  S DGLINE=DGLINE+1
  1.  S Y=$P(DGRP(.362),U,14),C=$P(^DD(2,.36235,0),U,2) D Y^DIQ
  1.  D SET^DGRPTL1(DGARY,DGLINE,"VA Pension: "_$S(Y'="":Y,1:"UNANSWERED"),12,.DGCNT)
  1.  ;
  1.  ;Primary elig code
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.36)=$G(^DPT(DFN,.36)) ;eligibility
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Primary Elig Code: "_$S($D(^DIC(8,+DGRP(.36),0)):$P(^(0),U,1),1:"UNANSWERED"),5,.DGCNT)
  1.  ;
  1.  ;Other elig codes
  1.  S DGLINE=DGLINE+1
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Other Elig Code(s): ",4,.DGCNT)
  1.  S (C,I)=0 F  S I=$O(^DPT("AEL",DFN,I)) Q:'I  I I'=+DGRP(.36),$D(^DIC(8,+I,0)) S DGRPENM=$P(^(0),U,1) D
  1.  . S C=C+1
  1.  . S:C>1 DGLINE=DGLINE+1
  1.  . D SET^DGRPTL1(DGARY,DGLINE,DGRPENM,24,.DGCNT)
  1.  D:'C SET^DGRPTL1(DGARY,DGLINE,"NO ADDITIONAL ELIGIBILITIES IDENTIFIED",24,.DGCNT)
  1.  ;
  1.  ;Period of service
  1.  S DGLINE=DGLINE+1
  1.  S DGRP(.32)=$G(^DPT(DFN,.32)) ;period of service
  1.  D SET^DGRPTL1(DGARY,DGLINE,"Period of Service: "_$S($D(^DIC(21,+$P(DGRP(.32),U,3),0)):$P(^(0),U,1),1:"UNANSWERED"),5,.DGCNT)
  1.  Q