| 1 | DVBCPRN1 ;ALB/GTS-557/THM-C&P FINAL REPORT PRINT ; 9/3/91 8:05 AM
|
|---|
| 2 | ;;2.7;AMIE;**31**;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | PHYS S PHYS=$S($D(^DVB(396.4,DA,0)):$P(^(0),U,7),1:"")
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | STEP2A S EXMNM=$S($D(^DVB(396.6,JI,0)):$P(^(0),U,1),1:"Unknown exam") I $D(AUTO),$D(XEXMNM),EXMNM'=XEXMNM Q ;print one exam on transcription
|
|---|
| 8 | S EXHD="For "_EXMNM_" Exam" D HDR W "Examining provider: ",PHYS,!,"Examined on: " S Y=$P(^DVB(396.4,DA,0),U,6) X XDD W Y,! F LINE=1:1:80 W "="
|
|---|
| 9 | W !!?2,"Examination results:",!! K NCN S EXSTAT=$P(^DVB(396.4,DA,0),U,4) I EXSTAT="X"!(EXSTAT="RX") W !!!!!?25,"This exam was CANCELLED by ",$S(EXSTAT="RX":"the RO.",1:"MAS."),!! Q
|
|---|
| 10 | D STEP3
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | STEP2 F DA=0:0 S DA=$O(^DVB(396.4,"C",DA(1),DA)) Q:DA="" S RO=+$P(^DVB(396.3,DA(1),0),U,3) Q:'$D(AUTO)&(DUZ(2)'=RO) S PG=0,JI=$P(^DVB(396.4,DA,0),U,3) D PHYS,STEP2A I $D(PRINT) D BOT K PRINT
|
|---|
| 14 | I '$D(AUTO) S %DT="TS",X="NOW" D ^%DT S DA=DA(1),CTIM=Y,DR="6////"_CTIM_";15////"_CTIM_";16////^S X=DUZ;17////C",DIE="^DVB(396.3,",DIC=DIE D ^DIE
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | STEP3 K ^UTILITY($J,"W") S DIWL=1,DIWR=80,DIWF="NW" S OLDA=DA,OLDA1=DA(1)
|
|---|
| 18 | F LINE=0:0 S LINE=$O(^DVB(396.4,OLDA,"RES",LINE)) Q:LINE="" S X=^DVB(396.4,OLDA,"RES",LINE,0) D ^DIWP,STEP3A
|
|---|
| 19 | D ^DIWW S PRINT=1 S DA=OLDA,DA(1)=OLDA1 Q
|
|---|
| 20 | ;
|
|---|
| 21 | STEP3A I $Y>(IOSL-11) D UP,NEXT,HDR W:$O(^DVB(396.4,OLDA,"RES",LINE))]"" !!,"Exam Results Continued",!!
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | HDR S PG=PG+1 I PG>1 D HDR2^DVBCUTL2 Q
|
|---|
| 25 | S:ZPR'="E" TOTTIME=$$PROCDAY^DVBCUTL2(DA(1))
|
|---|
| 26 | S:ZPR="E" TOTTIME=$$INSFTME^DVBCUTA1(DA(1))
|
|---|
| 27 | S OUTTIME="Processing time: "_TOTTIME
|
|---|
| 28 | W @IOF
|
|---|
| 29 | W !,"Date: ",DVBCDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG,!?(80-$L(DVBCSITE)\2),DVBCSITE,!
|
|---|
| 30 | W ?35,"** FINAL **",! W ?(80-$L(OUTTIME)\2),OUTTIME,!?(80-$L(EXHD)\2),EXHD,! F LNE=1:1:80 W "="
|
|---|
| 31 | K LNE S:EXHD["AGENT ORANGE" DVBCAO=1 I EXHD'["AGENT ORANGE" K DVBCAO
|
|---|
| 32 | D SSNOUT^DVBCUTIL
|
|---|
| 33 | W !!?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO,!?51,"C-Number: ",CNUM,!?56,"DOB: " S Y=DOB X XDD W Y,!?2,"Address: ",ADR1,! W:ADR2]"" ?11,ADR2,! W:ADR3]"" ?11,ADR3,!!
|
|---|
| 34 | K DVBCSSNO
|
|---|
| 35 | W !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,!
|
|---|
| 36 | W !,"Entered active service: " S Y=EOD X XDD S:Y="" Y="Not specified" W Y,?40,"Last rating exam date: ",LREXMDT,! S Y=RAD X XDD S:Y="" Y="Not specified" W "Released active service: " W Y,!!,"Priority of exam: ",PRIO,!
|
|---|
| 37 | F LNE=1:1:80 W "="
|
|---|
| 38 | W ! Q
|
|---|
| 39 | ;
|
|---|
| 40 | ZTSK S PG=0,AUTO=1 K ULINE
|
|---|
| 41 | ;$D(AUTO)=copy for review, Vet file after approval
|
|---|
| 42 | I '$D(DT) S X="T" D ^%DT S DT=Y
|
|---|
| 43 | S XDD=^DD("DD"),Y=DT X XDD S DVBCDT(0)=Y,PGHD="Compensation and Pension Exam Report",DVBCSITE=$S($D(^DVB(396.1,1,0)):$P(^(0),U,1),1:"Site name not in file")
|
|---|
| 44 | S $P(ULINE,"_",70)="_",XEXMNM=EXMNM K EXMNM D VARS^DVBCUTIL,STEP2,BOT
|
|---|
| 45 | I '$D(EDPRT) G KILL^DVBCUTIL
|
|---|
| 46 | Q
|
|---|
| 47 | ;
|
|---|
| 48 | UP F XIX=$Y:1:(IOSL-8) W !
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | NEXT W !,"Continued on next page",!,"VA Form 2507"
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | BOT I '$D(AUTO),$D(PRINT) D UP W ?7,"This exam has been reviewed and approved by the examining provider" W:$D(DVBCAO) !?27,"and signed by the veteran" W ".",!!,"VA Form 2507",! ;if for RO
|
|---|
| 55 | I $D(AUTO),$D(PRINT) D UP W ?7," Approved by: ___________________________________ Date: _____________",!!
|
|---|
| 56 | I $D(AUTO),$D(PRINT) W "Provider signature: ___________________________________ Date: _____________",!!,"VA Form 2507",! ;if file copy
|
|---|
| 57 | Q
|
|---|
