DVBCENQ1 ;ALB/GTS,557/THM - 2507 INQUIRY DISPLAY ; 10/14/2009 1:00 PM
;;2.7;AMIE;**17,57,143,149,193**;Apr 10, 1995;Build 84
;Per VHA Directive 2004-038, this routine should not be modified.
;
G START
CON K OUT I IOST?1"C-".E W !,"Press [RETURN] to continue or ""^"" to stop " R ANS:DTIME S:ANS=U!('$T) OUT=1 Q:$D(OUT) D HDR
I IOST?1"P-".E,$Y>45 W @IOF D HDR
Q
;
START S PGHD="COMPENSATION AND PENSION EXAM INQUIRY",PG=0
D HDR
W !?2,"Name: ",PNAM,?56,"SSN: ",SSN
W !?51,"C-Number: ",CNUM
W !?56,"DOB: " S Y=DOB X ^DD("DD") W Y
W !?4,"Address: ",ADR1
W ! W:ADR2]"" ?13,ADR2
W ! W:ADR3]"" ?13,ADR3
W !!?7,"City: ",CITY
I $$ISFORGN^DVBCUTIL(COUNTRY) D
. W !?3,"Province: ",PROVINCE,?48,"Res Phone: ",HOMPHON
. W !,"Postal Code: ",POSTALCD,?48,"Bus Phone: ",BUSPHON
E D
. W !?6,"State: ",STATE,?48,"Res Phone: ",HOMPHON
. W !?6,"Zip+4: ",ZIP,?48,"Bus Phone: ",BUSPHON
I COUNTRY>0 D
. W !?4,"Country: ",$$GETCNTRY^DVBCUTIL(COUNTRY),!
E D
. W !
W !,"Entered active service: " S Y=EOD X ^DD("DD") S:Y="" Y="Not specified" W Y,! S Y=RAD X ^DD("DD") S:Y="" Y="Not specified" W "Released active service: " W Y,!
F LINE=1:1:80 W "="
W !! D CON Q:$D(OUT) D ^DVBCENQ2,CON Q:$D(OUT) D ^DVBCEEXM,CON Q:$D(OUT) S REQDT=$P(^DVB(396.3,REQDA,0),U,2)
W !,"This request was initiated on " S Y=REQDT X ^DD("DD") W $P(Y,"@",1)," at ",$P(Y,"@",2),!!?17,"Requester: ",REQN,!,"Requesting Regional Office: ",RONAME,!
W "VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),!
I $D(^DVB(396.4,"C",REQDA)) W !?3,"Exams on this request: " D TST^DVBCUTL2 W !
I '$D(^DVB(396.4,"C",REQDA)) W !?3,"(No exams have yet been entered)",!
W !,"** Status of request: "
S RST=$P(^DVB(396.3,REQDA,0),U,18)
;AJF;Request Status conversion
S XSTAT=$$RSTAT^DVBCUTL8(RST)
S STAT=$$RTSTAT^DVBCUTL8(RST)
I STAT]"" W STAT
I XSTAT="R"!(XSTAT="C") W !!?9,"Released on " S Y=$P(^DVB(396.3,REQDA,0),U,14) X ^DD("DD") W Y," by " S RELBY=$P(^DVB(396.3,REQDA,0),U,15),RELBY=$S($D(^VA(200,+RELBY,0)):$P(^(0),U,1),1:"Unknown user") W RELBY,!
I XSTAT="C" W "Printed by the RO on " S Y=$P(^DVB(396.3,REQDA,0),U,16) X ^DD("DD") W Y," by " S PRBY=$P(^DVB(396.3,REQDA,0),U,17),PRBY=$S($D(^VA(200,+PRBY,0)):$P(^(0),U,1),1:"Unknown user") W PRBY,!
I STAT="" S STAT=$S(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown") W STAT I STAT["Cancelled" W " (Cancelled on " S CANDT=$P(^DVB(396.3,REQDA,0),U,19) W $$FMTE^XLFDT(CANDT,"5DZ"),")"
;S X=$S($D(^DVB(396.3,REQDA,4)):$P(^(4),U,1),1:"") I X="y" W !,"Exam(s) transferred to another site -- see pending report.",!
I $D(^DVB(396.3,REQDA,1)),$P(^(1),U,3)="Y" W !,"This request was faxed to the regional office.",!
S FEXAM=$P(^DVB(396.3,REQDA,0),U,9) I FEXAM="Y" W !!,"*** Exams done on a FEE BASIS *** ",! K FEXAM
W ! F LINE=1:1:79 W "-"
W ! D DDIS Q:$D(OUT) D CON Q:$D(OUT)
I IOST?1"P-".E,$Y>45 W @IOF D HDR
W !!,"Other Disabilities:",!!?2,OTHDIS,! I $D(^DVB(396.3,REQDA,1)) W ?2,OTHDIS1,!?2,OTHDIS2
W !!,"General Remarks:",!!
K ^UTILITY($J,"W")
F LINE=0:0 S LINE=$O(^DVB(396.3,REQDA,2,LINE)) Q:LINE="" S X=^(LINE,0),DIWL=5,DIWR=75,DIWF="NW" D ^DIWP I IOST?1"C-".E,$Y>19 D CON W !!,"General Remarks, continued",!!!
D ^DIWW
END K ANS I IOST?1"C-".E W !!,"Press [RETURN] to continue or ""^"" to stop " R ANS:DTIME S:'$T!(ANS=U) OUT=1 I $D(OUT) Q:OUT=1
Q
;
DDIS1 W ?2,DX,?37,$J(PCT,3,0)," %",?50,$S(SC=1:"Yes",1:"No"),?58,DXCOD,!
I $Y>19 D CON
Q
;
DDIS I $Y>12 D CON Q:$D(OUT)
I '$D(^DPT(DFN,.372)) W !?25,"No rated disabilities on file",!! Q
W !?2,"Rated Disability",?37,"Percent",?50,"SC ?",?58,"Dx Code",! W ?2 F LINE=1:1:63 W "-"
W !!
F JII=0:0 S JII=$O(^DPT(DFN,.372,JII)) Q:JII="" S DXNUM=$P(^DPT(DFN,.372,JII,0),U,1),PCT=$P(^(0),U,2),SC=$P(^(0),U,3),DX=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,1),1:"Unknown"),DXCOD=$S($D(^DIC(31,DXNUM)):$P(^(DXNUM,0),U,3),1:"Unknown") D DDIS1
W !!
Q
;
HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF
W !,"Date: ",FDT(0),?(80-$L(PGHD)\2),PGHD,?71,"Page: ",PG W !,?(80-$L($$SITE^DVBCUTL4)\2),$$SITE^DVBCUTL4 I PG>1 W !!,"Name: ",PNAM,?44,"SSN: ",SSN,?63,"C-NUM: ",CNUM
W ! F XLINE=1:1:80 W "="
W ! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCENQ1 4211 printed Sep 23, 2025@19:20:04 Page 2
DVBCENQ1 ;ALB/GTS,557/THM - 2507 INQUIRY DISPLAY ; 10/14/2009 1:00 PM
+1 ;;2.7;AMIE;**17,57,143,149,193**;Apr 10, 1995;Build 84
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 GOTO START
CON KILL OUT
IF IOST?1"C-".E
WRITE !,"Press [RETURN] to continue or ""^"" to stop "
READ ANS:DTIME
if ANS=U!('$TEST)
SET OUT=1
if $DATA(OUT)
QUIT
DO HDR
+1 IF IOST?1"P-".E
IF $Y>45
WRITE @IOF
DO HDR
+2 QUIT
+3 ;
START SET PGHD="COMPENSATION AND PENSION EXAM INQUIRY"
SET PG=0
+1 DO HDR
+2 WRITE !?2,"Name: ",PNAM,?56,"SSN: ",SSN
+3 WRITE !?51,"C-Number: ",CNUM
+4 WRITE !?56,"DOB: "
SET Y=DOB
XECUTE ^DD("DD")
WRITE Y
+5 WRITE !?4,"Address: ",ADR1
+6 WRITE !
if ADR2]""
WRITE ?13,ADR2
+7 WRITE !
if ADR3]""
WRITE ?13,ADR3
+8 WRITE !!?7,"City: ",CITY
+9 IF $$ISFORGN^DVBCUTIL(COUNTRY)
Begin DoDot:1
+10 WRITE !?3,"Province: ",PROVINCE,?48,"Res Phone: ",HOMPHON
+11 WRITE !,"Postal Code: ",POSTALCD,?48,"Bus Phone: ",BUSPHON
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 WRITE !?6,"State: ",STATE,?48,"Res Phone: ",HOMPHON
+14 WRITE !?6,"Zip+4: ",ZIP,?48,"Bus Phone: ",BUSPHON
End DoDot:1
+15 IF COUNTRY>0
Begin DoDot:1
+16 WRITE !?4,"Country: ",$$GETCNTRY^DVBCUTIL(COUNTRY),!
End DoDot:1
+17 IF '$TEST
Begin DoDot:1
+18 WRITE !
End DoDot:1
+19 WRITE !,"Entered active service: "
SET Y=EOD
XECUTE ^DD("DD")
if Y=""
SET Y="Not specified"
WRITE Y,!
SET Y=RAD
XECUTE ^DD("DD")
if Y=""
SET Y="Not specified"
WRITE "Released active service: "
WRITE Y,!
+20 FOR LINE=1:1:80
WRITE "="
+21 WRITE !!
DO CON
if $DATA(OUT)
QUIT
DO ^DVBCENQ2
DO CON
if $DATA(OUT)
QUIT
DO ^DVBCEEXM
DO CON
if $DATA(OUT)
QUIT
SET REQDT=$PIECE(^DVB(396.3,REQDA,0),U,2)
+22 WRITE !,"This request was initiated on "
SET Y=REQDT
XECUTE ^DD("DD")
WRITE $PIECE(Y,"@",1)," at ",$PIECE(Y,"@",2),!!?17,"Requester: ",REQN,!,"Requesting Regional Office: ",RONAME,!
+23 WRITE "VHA Division Processing Request: "_$PIECE($$SITE^VASITE(,$PIECE(^DVB(396.3,REQDA,1),U,4)),U,2),!
+24 IF $DATA(^DVB(396.4,"C",REQDA))
WRITE !?3,"Exams on this request: "
DO TST^DVBCUTL2
WRITE !
+25 IF '$DATA(^DVB(396.4,"C",REQDA))
WRITE !?3,"(No exams have yet been entered)",!
+26 WRITE !,"** Status of request: "
+27 SET RST=$PIECE(^DVB(396.3,REQDA,0),U,18)
+28 ;AJF;Request Status conversion
+29 SET XSTAT=$$RSTAT^DVBCUTL8(RST)
+30 SET STAT=$$RTSTAT^DVBCUTL8(RST)
+31 IF STAT]""
WRITE STAT
+32 IF XSTAT="R"!(XSTAT="C")
WRITE !!?9,"Released on "
SET Y=$PIECE(^DVB(396.3,REQDA,0),U,14)
XECUTE ^DD("DD")
WRITE Y," by "
SET RELBY=$PIECE(^DVB(396.3,REQDA,0),U,15)
SET RELBY=$SELECT($DATA(^VA(200,+RELBY,0)):$PIECE(^(0),U,1),1:"Unknown user")
WRITE RELBY,!
+33 IF XSTAT="C"
WRITE "Printed by the RO on "
SET Y=$PIECE(^DVB(396.3,REQDA,0),U,16)
XECUTE ^DD("DD")
WRITE Y," by "
SET PRBY=$PIECE(^DVB(396.3,REQDA,0),U,17)
SET PRBY=$SELECT($DATA(^VA(200,+PRBY,0)):$PIECE(^(0),U,1),1:"Unknown user")
WRITE PRBY,!
+34 IF STAT=""
SET STAT=$SELECT(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown")
WRITE STAT
IF STAT["Cancelled"
WRITE " (Cancelled on "
SET CANDT=$PIECE(^DVB(396.3,REQDA,0),U,19)
WRITE $$FMTE^XLFDT(CANDT,"5DZ"),")"
+35 ;S X=$S($D(^DVB(396.3,REQDA,4)):$P(^(4),U,1),1:"") I X="y" W !,"Exam(s) transferred to another site -- see pending report.",!
+36 IF $DATA(^DVB(396.3,REQDA,1))
IF $PIECE(^(1),U,3)="Y"
WRITE !,"This request was faxed to the regional office.",!
+37 SET FEXAM=$PIECE(^DVB(396.3,REQDA,0),U,9)
IF FEXAM="Y"
WRITE !!,"*** Exams done on a FEE BASIS *** ",!
KILL FEXAM
+38 WRITE !
FOR LINE=1:1:79
WRITE "-"
+39 WRITE !
DO DDIS
if $DATA(OUT)
QUIT
DO CON
if $DATA(OUT)
QUIT
+40 IF IOST?1"P-".E
IF $Y>45
WRITE @IOF
DO HDR
+41 WRITE !!,"Other Disabilities:",!!?2,OTHDIS,!
IF $DATA(^DVB(396.3,REQDA,1))
WRITE ?2,OTHDIS1,!?2,OTHDIS2
+42 WRITE !!,"General Remarks:",!!
+43 KILL ^UTILITY($JOB,"W")
+44 FOR LINE=0:0
SET LINE=$ORDER(^DVB(396.3,REQDA,2,LINE))
if LINE=""
QUIT
SET X=^(LINE,0)
SET DIWL=5
SET DIWR=75
SET DIWF="NW"
DO ^DIWP
IF IOST?1"C-".E
IF $Y>19
DO CON
WRITE !!,"General Remarks, continued",!!!
+45 DO ^DIWW
END KILL ANS
IF IOST?1"C-".E
WRITE !!,"Press [RETURN] to continue or ""^"" to stop "
READ ANS:DTIME
if '$TEST!(ANS=U)
SET OUT=1
IF $DATA(OUT)
if OUT=1
QUIT
+1 QUIT
+2 ;
DDIS1 WRITE ?2,DX,?37,$JUSTIFY(PCT,3,0)," %",?50,$SELECT(SC=1:"Yes",1:"No"),?58,DXCOD,!
+1 IF $Y>19
DO CON
+2 QUIT
+3 ;
DDIS IF $Y>12
DO CON
if $DATA(OUT)
QUIT
+1 IF '$DATA(^DPT(DFN,.372))
WRITE !?25,"No rated disabilities on file",!!
QUIT
+2 WRITE !?2,"Rated Disability",?37,"Percent",?50,"SC ?",?58,"Dx Code",!
WRITE ?2
FOR LINE=1:1:63
WRITE "-"
+3 WRITE !!
+4 FOR JII=0:0
SET JII=$ORDER(^DPT(DFN,.372,JII))
if JII=""
QUIT
SET DXNUM=$PIECE(^DPT(DFN,.372,JII,0),U,1)
SET PCT=$PIECE(^(0),U,2)
SET SC=$PIECE(^(0),U,3)
SET DX=$SELECT($DATA(^DIC(31,DXNUM)):$PIECE(^(DXNUM,0),U,1),1:"Unknown")
SET DXCOD=$SELECT($DATA(^DIC(31,DXNUM)):$PIECE(^(DXNUM,0),U,3),1:"Unknown")
DO DDIS1
+5 WRITE !!
+6 QUIT
+7 ;
HDR SET PG=PG+1
if (IOST?1"C-".E)
WRITE @IOF
+1 WRITE !,"Date: ",FDT(0),?(80-$LENGTH(PGHD)\2),PGHD,?71,"Page: ",PG
WRITE !,?(80-$LENGTH($$SITE^DVBCUTL4)\2),$$SITE^DVBCUTL4
IF PG>1
WRITE !!,"Name: ",PNAM,?44,"SSN: ",SSN,?63,"C-NUM: ",CNUM
+2 WRITE !
FOR XLINE=1:1:80
WRITE "="
+3 WRITE !
QUIT
