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