- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCREQ1.m
r613 r623 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 1 DVBCREQ1 ;ALB/GTS-557/THM-NEW 2507 REQUEST PRINTING ; 5/25/91 11:36 AM 2 ;;2.7;AMIE;**19,29**;Apr 10, 1995 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 9 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,! 10 F LINE=1:1:80 W "=" 11 S TVAR(1,0)="0,0,0,2:1,0^** Priority of exam: "_PRIO 12 D WR^DVBAUTL4("TVAR") 13 K TVAR 14 I $D(^DVB(396.3,DA(1),5)),(+$P(^DVB(396.3,DA(1),5),U,1)>0) DO 15 .I $D(DVBAINSF),($D(^DVB(396.3,$P(^DVB(396.3,DA(1),5),U,1),0))) DO 16 ..S Y=$P(^DVB(396.3,$P(^DVB(396.3,DA(1),5),U,1),0),U,5) X ^DD("DD") 17 ..S TVAR(1,0)="0,0,0,0,0^Date original 2507 Reported to MAS: "_Y K Y 18 ..D WR^DVBAUTL4("TVAR") 19 ..K TVAR 20 S TVAR(1,0)="0,0,0,3:2,0^Selected exams: " 21 D WR^DVBAUTL4("TVAR") 22 K TVAR 23 D TST^DVBCUTL3 G:($D(GETOUT)) EXIT 24 W !!!!! I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT 25 W "Current Rated disabilities:",!! D DDIS^DVBCUTL3 G:($D(GETOUT)) EXIT 26 W "Other Disabilities:",!!?2,OTHDIS,!?2,OTHDIS1,!?2,OTHDIS2,!!,"General remarks:",!! 27 K ^UTILITY($J,"W") 28 I IOST?1"C-".E D CRTBOT G:$D(GETOUT) EXIT 29 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 30 D:('$D(GETOUT)) ^DIWW 31 ; ** Exit TAG ** 32 EXIT D:('$D(GETOUT)) BOT K GETOUT,LPCNT,DVBCDX,DVBCSC,DVBCSSNO Q 33 ; 34 HDR S PG=PG+1 I '$D(ONE)!(($D(ONE))&(PG>1))!(IOST?1"C-".E) W @IOF 35 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 36 W ?(80-$L(PRTDIV)\2),PRTDIV 37 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,! 38 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 "=" 39 K XLN Q 40 ; 41 CRTBOT ; ** Write form number at bottom of CRT ** 42 I $P(^DVB(396.3,DA(1),0),U,23)="Y" W !?20,"** Claim folder review will be required **",! 43 F LPCNT=$Y:1:(IOSL-7) W ! 44 W !,"VA Form 21-2507" 45 D TERM^DVBCUTL3 46 Q 47 ; 48 BOT I $P(^DVB(396.3,DA(1),0),U,23)="Y" W !?20,"** Claim folder review will be required **",! 49 I IOST?1"C-".E F LPCNT=$Y:1:(IOSL-6) W ! 50 I IOST'?1"C-".E F LPCNT=$Y:1:(IOSL-4) W ! 51 W !,"VA Form 21-2507" 52 I IOST?1"C-".E D TERM^DVBCUTL3 53 Q 54 ; 55 RMRK W !?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO 56 W ! F XLN=1:1:80 W "=" 57 W !!,"General remarks (continued):",!! 58 Q
Note:
See TracChangeset
for help on using the changeset viewer.
