[628] | 1 | DVBCREQ1 ;ALB/GTS-557/THM-NEW 2507 REQUEST PRINTING ; 5/25/91 11:36 AM
|
---|
| 2 | ;;2.7;AMIE;**19,29,126**;Apr 10, 1995;Build 8
|
---|
| 3 | ;
|
---|
| 4 | START S PGHD="COMPENSATION AND PENSION EXAM REQUEST",ROHD="Requested by "_RONAME,PG=0
|
---|
| 5 | D HDR
|
---|
| 6 | D SSNOUT^DVBCUTIL ;** Set the value of DVBCSSNO
|
---|
| 7 | W !?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO,!?51,"C-Number: ",CNUM,!?56,"DOB: " S Y=DOB X ^DD("DD") W Y,!?2,"Address: ",ADR1,! W:ADR2]"" ?11,ADR2,! W:ADR3]"" ?11,ADR3,!!
|
---|
| 8 | W ?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,! ;I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT ;DVBA/126 comment off this code
|
---|
| 9 | I $D(^DPT(DFN,.121)) I $D(DTT) D ;DVBA/126
|
---|
| 10 | .Q:$P(DTT,U,9)=""!($P(DTT,U,9)="N")
|
---|
| 11 | .I $P(DTT,U,7)'="" Q:$P(DTT,U,7)>DT
|
---|
| 12 | .I $P(DTT,U,8)'="" Q:$P(DTT,U,8)<DT
|
---|
| 13 | .W !?2,"Temporary Address: ",TAD1,! W:TAD2]"" ?21,TAD2,! W:TAD3]"" ?21,TAD3,!
|
---|
| 14 | .W ?2,"City,State,Zip+4: ",?48,"Temporary Phone: ",!?5,TCITY," ",TST," ",TZIP,?51,TPHONE,!
|
---|
| 15 | I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT ;DVBA/126
|
---|
| 16 | W !,"Entered active service: " S Y=EOD X ^DD("DD") S:Y="" Y="Not specified" W Y,?40,"Last rating exam date: ",LREXMDT,! S Y=RAD X ^DD("DD") S:Y="" Y="Not specified" W "Released active service: " W Y,!
|
---|
| 17 | F LINE=1:1:80 W "="
|
---|
| 18 | S TVAR(1,0)="0,0,0,2:1,0^** Priority of exam: "_PRIO
|
---|
| 19 | D WR^DVBAUTL4("TVAR")
|
---|
| 20 | K TVAR
|
---|
| 21 | I $D(^DVB(396.3,DA(1),5)),(+$P(^DVB(396.3,DA(1),5),U,1)>0) DO
|
---|
| 22 | .I $D(DVBAINSF),($D(^DVB(396.3,$P(^DVB(396.3,DA(1),5),U,1),0))) DO
|
---|
| 23 | ..S Y=$P(^DVB(396.3,$P(^DVB(396.3,DA(1),5),U,1),0),U,5) X ^DD("DD")
|
---|
| 24 | ..S TVAR(1,0)="0,0,0,0,0^Date original 2507 Reported to MAS: "_Y K Y
|
---|
| 25 | ..D WR^DVBAUTL4("TVAR")
|
---|
| 26 | ..K TVAR
|
---|
| 27 | S TVAR(1,0)="0,0,0,3:2,0^Selected exams: "
|
---|
| 28 | D WR^DVBAUTL4("TVAR")
|
---|
| 29 | K TVAR
|
---|
| 30 | D TST^DVBCUTL3 G:($D(GETOUT)) EXIT
|
---|
| 31 | W !!!!! I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT
|
---|
| 32 | W "Current Rated disabilities:",!! D DDIS^DVBCUTL3 G:($D(GETOUT)) EXIT
|
---|
| 33 | W "Other Disabilities:",!!?2,OTHDIS,!?2,OTHDIS1,!?2,OTHDIS2,!!,"General remarks:",!!
|
---|
| 34 | K ^UTILITY($J,"W")
|
---|
| 35 | I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT
|
---|
| 36 | F LINE=0:0 S LINE=$O(^DVB(396.3,DA(1),2,LINE)) Q:(LINE="")!($D(GETOUT)) S X=^(LINE,0),DIWL=1,DIWF="NW" D ^DIWP I $Y>(IOSL-7),$O(^DVB(396.3,DA(1),2,LINE))]"" D BOT D:'$D(GETOUT) HDR,RMRK
|
---|
| 37 | D:('$D(GETOUT)) ^DIWW
|
---|
| 38 | ; ** Exit TAG **
|
---|
| 39 | EXIT D:('$D(GETOUT)) BOT K GETOUT,LPCNT,DVBCDX,DVBCSC,DVBCSSNO,DTT,TAD1,TAD2,TAD3,TCITY,TST,TZIP,TPHONE Q
|
---|
| 40 | ;
|
---|
| 41 | HDR S PG=PG+1 I '$D(ONE)!(($D(ONE))&(PG>1))!(IOST?1"C-".E) W @IOF
|
---|
| 42 | W !,"Date: ",DVBCDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG,! S PRTDIV=$S($D(^DG(40.8,XDIV,0)):$P(^(0),U,1),1:"Unknown division") S PRTDIV="For "_PRTDIV_" Medical Center Division at "_$$SITE^DVBCUTL4
|
---|
| 43 | W ?(80-$L(PRTDIV)\2),PRTDIV
|
---|
| 44 | W !! S Y=$P(^DVB(396.3,DA(1),0),U,22) I Y]"" S Z="*** Transferred from ",Z=Z_$S($D(^DIC(4.2,+Y,0)):$P(^(0),U,1),1:"unknown site")_" ***" W ?(80-$L(Z)\2),Z,!
|
---|
| 45 | W ?(80-$L(ROHD)\2),ROHD,! S RQ="Date Requested: ",Y=DTRQ X ^DD("DD") S RQ=RQ_Y W ?(80-$L(RQ)\2),RQ,! F XLN=1:1:80 W "="
|
---|
| 46 | K XLN Q
|
---|
| 47 | ;
|
---|
| 48 | CRTBOT ; ** Write form number at bottom of CRT **
|
---|
| 49 | I $P(^DVB(396.3,DA(1),0),U,23)="Y" W !?20,"** Claim folder review will be required **",!
|
---|
| 50 | F LPCNT=$Y:1:(IOSL-7) W !
|
---|
| 51 | W !,"VA Form 21-2507"
|
---|
| 52 | D TERM^DVBCUTL3
|
---|
| 53 | Q
|
---|
| 54 | ;
|
---|
| 55 | BOT I $P(^DVB(396.3,DA(1),0),U,23)="Y" W !?20,"** Claim folder review will be required **",!
|
---|
| 56 | I IOST?1"C-".E F LPCNT=$Y:1:(IOSL-6) W !
|
---|
| 57 | I IOST'?1"C-".E F LPCNT=$Y:1:(IOSL-4) W !
|
---|
| 58 | W !,"VA Form 21-2507"
|
---|
| 59 | I IOST?1"C-".E D TERM^DVBCUTL3
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | RMRK W !?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO
|
---|
| 63 | W ! F XLN=1:1:80 W "="
|
---|
| 64 | W !!,"General remarks (continued):",!!
|
---|
| 65 | Q
|
---|