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

DVBAVDPT.m

Go to the documentation of this file.
  1. DVBAVDPT ;ALB/JLU,557/THM-GET VARIABLES VIA ^VADPT ; 1/23/91 8:02 AM
  1. ;;2.7;AMIE;**57,108**;Apr 10, 1995
  1. W *7,!!,"NOT a stand-alone program !",!!,*7 Q
  1. ;
  1. DCHGDT ;entry point for all reports that use discharge dates
  1. ;called by D DCHGDT^DVBAVDPT
  1. S DCHGDT=MA,VAINDT=$S(MA[".":MA-.000002,1:MA),VA200="" D INP^VADPT K VA200 S ADMDT=$P(VAIN(7),".") G EN
  1. ;
  1. ADM ;entry point for all reports that use admission dates
  1. ;called by D ADM^DVBAVDPT only
  1. I $D(MA),MA]"" S (ADMDT,VAINDT)=MA S VA200="" D INP^VADPT K VA200 S ADMNUM=VAIN(1),DCHGDT="",DCHPTR=$S($D(^DGPM(+ADMNUM,0)):$P(^(0),U,17),1:"") G:DCHPTR="" EN I DCHPTR]"",$D(^DGPM(DCHPTR,0)) S DCHGDT=$P(^(0),U,1) G EN
  1. S VAINDT=$S($D(ADMDT):ADMDT,1:""),VA200="" D INP^VADPT K VA200 S ADMNUM=VAIN(1),DCHGDT="",DCHPTR=$S($D(^DGPM(+ADMNUM,0)):$P(^(0),U,17),1:"") I DCHPTR]"",$D(^DGPM(DCHPTR,0)) S DCHGDT=$P(^(0),U,1)
  1. Q:$D(DVBARADQ)
  1. ;
  1. EN ;general entry point
  1. S (DVBAELIG,DVBAELST)="" I $D(^DPT(DFN,.36)),$P(^(.36),U)]"" S DVBAELIG=$S($D(^DIC(8,+^(.36),0)):$P(^(0),U,6),1:"")
  1. I DVBAELIG]"",$D(^DPT(DFN,.361)),^(.361)]"" S DVBAELST=$P(^(.361),U)
  1. S PNAM=$P(^DPT(DFN,0),U),SSN=$P(^(0),U,9),WARD=$P(VAIN(4),U),DIAG=VAIN(9),ADMNUM=VAIN(1)
  1. S WARD=$S($D(^DIC(42,+WARD,0)):^(0),1:""),BEDSEC=$S($P(WARD,U,2)]"":$P(WARD,U,2),1:"UNKNOWN"),WARD=$S($P(WARD,U)]"":$P(WARD,U),1:"UNKNOWN")
  1. K VAEL,VAERR,VADM,VAIN,VAINDT,DVBAPGM,VAMB,ADMNUM,DVBAX,DVBAY
  1. RCV ;A&A and Pension
  1. ;
  1. ;* QUIT1 set by DVBAADRP, DVBACMRP, DVBADSNT, DVBADSRP, DVBADSRT,
  1. ;* DVBARAD1, DVBASPD2
  1. Q:$D(QUIT1) S RCVAA=$S($D(^DPT(DFN,.362)):^(.362),1:""),RCVPEN=$P(RCVAA,U,14),RCVAA=$P(RCVAA,U,12)
  1. S RCVAA=$S(RCVAA="Y":1,RCVAA="N":0,1:""),RCVPEN=$S(RCVPEN="Y":1,RCVPEN="N":0,1:"")
  1. SC ;Service Connection
  1. S DVBASC=$S($D(^DPT(DFN,.3)):$P(^(.3),U),1:"")
  1. CNUM ;Claim Number and Location
  1. S CNUM=$S($D(^DPT(DFN,.31)):^(.31),1:"")
  1. S CFLOC=+$P(CNUM,U,4)
  1. S CNUM=$P(CNUM,U,3)
  1. S:CNUM="" CNUM="UNKNOWN"
  1. S XCN=$E(CNUM,$L(CNUM)-1,$L(CNUM))
  1. ; DVBA*2.7*108 - Modified next line for null values
  1. ; S CFLOC=$S($D(^DIC(4,CFLOC,99)):$P(^(99),U,1),1:"UNKNOWN")
  1. S CFLOC=$P($G(^DIC(4,CFLOC,99)),"^") S:CFLOC="" CFLOC="UNKNOWN"
  1. Q
  1. ;
  1. ELIG N ED S ELIG=DVBAELIG,INCMP="",ED="Eligibility data:"
  1. I ELIG]"" S ELIG=ELIG_" ("_$S(DVBAELST="P":"Pend Ver",DVBAELST="R":"Pend Re-verif",DVBAELST="V":"Verified",1:"Not Verified")_")"
  1. I $D(^DPT(DA,.29)) S INCMP=$S($P(^(.29),U,12)=1:"Incompetent",1:"")
  1. I INCMP]"",ELIG]"" S ELIG=ELIG_", "
  1. I '$D(DVBC)!'$$BROKER^XWBLIB W ?6,ED,?26,ELIG W:$X>60 !?26 W INCMP,! Q
  1. S DVBC=DVBC+1,ED=" "_ED_" ",^TMP("DVBSPCRP",$J,DVBC)=ED_ELIG
  1. I $L(^(DVBC))<60 S ^(DVBC)=^(DVBC)_INCMP ;NakedRefs = ^TMP("DVBSPCRP",$J,DVBC)
  1. E S DVBC=DVBC+1,$P(^(DVBC)," ",25)=" "_INCMP
  1. S DVBC=DVBC+1
  1. Q
  1. ;
  1. NOTES ;Supported fields for this routine
  1. ;.362 Disability Ret from Military
  1. ;.291 Date ruled incomp (VA)
  1. ;.292 Date ruled incomp (civil)
  1. ;.293 Rated incomp?
  1. ;.313 Claim number
  1. ;.312 Claim folder loc (as free text)
  1. ;2.101 Log-in date/time
  1. ;File 44 field .02 Bedsection
  1. ;Elig file Print name