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