- DVBCRPR1 ;ALBANY-ISC/GTS-REPRINT C&P REPORT CONTINUED ;4/28/93
- ;;2.7;AMIE;**2,119,156,200**;Apr 10, 1995;Build 2
- ;
- ; ** Entry points called only from DVBCRPRT **
- ; ** All TAGS are entry points **
- HDR S PG=PG+1
- I +$G(DVBGUI)&(PG>1) Q
- I PG>1 D HDR3^DVBCUTL2 Q
- S:ZPR'="E" TOTTIME=$$PROCDAY^DVBCUTL2(DA(1))
- S:ZPR="E" TOTTIME=$$INSFTME^DVBCUTA1(DA(1))
- S OUTTIME="Processing time: "_TOTTIME
- I (IOST?1"C-".E)!($D(DVBAON2)) W @IOF
- S:('$D(DVBAON2)) DVBAON2=""
- W !,"Date: ",DVBCDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG,!?(80-$L(DVBCSITE)\2),DVBCSITE,!
- W ?29,"** REPRINT OF FINAL **",! W ?(80-$L(OUTTIME)\2),OUTTIME,!
- W ?(80-$L(EXHD)\2),EXHD,! F LNE=1:1:80 W "="
- K LNE S:EXHD["AGENT ORANGE" DVBCAO=1 I EXHD'["AGENT ORANGE" K DVBCAO
- D SSNOUT^DVBCUTIL
- 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,!!
- K DVBCSSNO
- W !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,!
- 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,!
- F LNE=1:1:80 W "="
- W !
- Q
- ;
- UP F XIX=$Y:1:(IOSL-8) W ! ;DVBA*156 add more lines for footer padding
- Q
- ;
- BOT I '$D(AUTO),$D(PRINT) D UP W ?7,"This exam has been reviewed and approved by the examining physician" W:$D(DVBCAO) !?27,"and signed by the veteran" W ".",!!,"VA Form 2507",! ;for RO
- I $D(AUTO),$D(PRINT) D UP W ?7,"Adequated by: ___________________________________ Date: _____________",!!
- I $D(AUTO),$D(PRINT) W "Physician signature: ___________________________________ Date: _____________",!!,"VA Form 2507",!
- Q
- ;
- HDA S:'$D(XPG) XPG=0 S XPG=XPG+1
- I (IOST?1"C-".E)!($D(DVBAON2)) W @IOF
- S:('$D(DVBAON2)) DVBAON2=""
- ;CHANGE PRINT DATE TO REFLECT THE DATE THE REPORT WAS RUN FOR - NOT THE DATE THE REPORT WAS RUN
- ;RRA DVBA*2.7*200 I7344966FY16
- W !,"Final C&P Reports for print date " S Y=RUNDATE X XDD W Y,!!,"Operator: ",$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown operator"),!,"Location: ",$S($D(^DIC(4,+DUZ(2),0)):$P(^(0),U,1),1:"Unknown location"),!
- W !,"Veteran Name",?28,"SSN",?43,"C-Number",?55,"Request date",!
- F XXLN=1:1:79 W "-"
- W !!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCRPR1 2388 printed Feb 18, 2025@23:15:01 Page 2
- DVBCRPR1 ;ALBANY-ISC/GTS-REPRINT C&P REPORT CONTINUED ;4/28/93
- +1 ;;2.7;AMIE;**2,119,156,200**;Apr 10, 1995;Build 2
- +2 ;
- +3 ; ** Entry points called only from DVBCRPRT **
- +4 ; ** All TAGS are entry points **
- HDR SET PG=PG+1
- +1 IF +$GET(DVBGUI)&(PG>1)
- QUIT
- +2 IF PG>1
- DO HDR3^DVBCUTL2
- QUIT
- +3 if ZPR'="E"
- SET TOTTIME=$$PROCDAY^DVBCUTL2(DA(1))
- +4 if ZPR="E"
- SET TOTTIME=$$INSFTME^DVBCUTA1(DA(1))
- +5 SET OUTTIME="Processing time: "_TOTTIME
- +6 IF (IOST?1"C-".E)!($DATA(DVBAON2))
- WRITE @IOF
- +7 if ('$DATA(DVBAON2))
- SET DVBAON2=""
- +8 WRITE !,"Date: ",DVBCDT(0),?(80-$LENGTH(PGHD)\2),PGHD,?71,"Page: ",PG,!?(80-$LENGTH(DVBCSITE)\2),DVBCSITE,!
- +9 WRITE ?29,"** REPRINT OF FINAL **",!
- WRITE ?(80-$LENGTH(OUTTIME)\2),OUTTIME,!
- +10 WRITE ?(80-$LENGTH(EXHD)\2),EXHD,!
- FOR LNE=1:1:80
- WRITE "="
- +11 KILL LNE
- if EXHD["AGENT ORANGE"
- SET DVBCAO=1
- IF EXHD'["AGENT ORANGE"
- KILL DVBCAO
- +12 DO SSNOUT^DVBCUTIL
- +13 WRITE !!?2,"Name: ",PNAM,?56,"SSN: ",DVBCSSNO,!?51,"C-Number: ",CNUM,!?56,"DOB: "
- SET Y=DOB
- XECUTE XDD
- WRITE Y,!?2,"Address: ",ADR1,!
- if ADR2]""
- WRITE ?11,ADR2,!
- if ADR3]""
- WRITE ?11,ADR3,!!
- +14 KILL DVBCSSNO
- +15 WRITE !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,!
- +16 WRITE !,"Entered active service: "
- SET Y=EOD
- XECUTE XDD
- if Y=""
- SET Y="Not specified"
- WRITE Y,?40,"Last rating exam date: ",LREXMDT,!
- SET Y=RAD
- XECUTE XDD
- if Y=""
- SET Y="Not specified"
- WRITE "Released active service: "
- WRITE Y,!!,"Priority of exam: ",PRIO,!
- +17 FOR LNE=1:1:80
- WRITE "="
- +18 WRITE !
- +19 QUIT
- +20 ;
- UP ;DVBA*156 add more lines for footer padding
- FOR XIX=$Y:1:(IOSL-8)
- WRITE !
- +1 QUIT
- +2 ;
- BOT ;for RO
- IF '$DATA(AUTO)
- IF $DATA(PRINT)
- DO UP
- WRITE ?7,"This exam has been reviewed and approved by the examining physician"
- if $DATA(DVBCAO)
- WRITE !?27,"and signed by the veteran"
- WRITE ".",!!,"VA Form 2507",!
- +1 IF $DATA(AUTO)
- IF $DATA(PRINT)
- DO UP
- WRITE ?7,"Adequated by: ___________________________________ Date: _____________",!!
- +2 IF $DATA(AUTO)
- IF $DATA(PRINT)
- WRITE "Physician signature: ___________________________________ Date: _____________",!!,"VA Form 2507",!
- +3 QUIT
- +4 ;
- HDA if '$DATA(XPG)
- SET XPG=0
- SET XPG=XPG+1
- +1 IF (IOST?1"C-".E)!($DATA(DVBAON2))
- WRITE @IOF
- +2 if ('$DATA(DVBAON2))
- SET DVBAON2=""
- +3 ;CHANGE PRINT DATE TO REFLECT THE DATE THE REPORT WAS RUN FOR - NOT THE DATE THE REPORT WAS RUN
- +4 ;RRA DVBA*2.7*200 I7344966FY16
- +5 WRITE !,"Final C&P Reports for print date "
- SET Y=RUNDATE
- XECUTE XDD
- WRITE Y,!!,"Operator: ",$SELECT($DATA(^VA(200,+DUZ,0)):$PIECE(^(0),U,1),1:"Unknown operator"),!,"Location: ",$SELECT($DATA(^DIC(4,+DUZ(2),0)):$PIECE(^(0),U,1),1:"Unknown location"),!
- +6 WRITE !,"Veteran Name",?28,"SSN",?43,"C-Number",?55,"Request date",!
- +7 FOR XXLN=1:1:79
- WRITE "-"
- +8 WRITE !!
- +9 QUIT