61 lines
2.9 KiB
Mathematica
61 lines
2.9 KiB
Mathematica
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
|