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 Dec 13, 2024@01:42:26 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
