DVBAB70 ;ALB/SPH - CAPRI C&P EXAM INQUIRY ;09/28/2009
;;2.7;AMIE;**35,42,57,136,143,149,193**;Apr 10, 1995;Build 84
;Per VHA Directive 2004-038, this routine should not be modified.
;
STRT(ZMSG,DFN,ZREQDA) ;
N DVBABCNT,REQDA,DA,X,Y,PNAM,NAME,DOB,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE
N HOMPHON,BUSPHON,OTHDIS,OTHDIS1,OTHDIS2,COUNTY,PROVINCE,POSTALCD,COUNTRY
N ZIP,CANDT,PRBY,RELBY,DX,DXCOD,DXNUM,JII,PCT,SC,EDTA,EOD,RAD,LINE
N REQN,REQDT,RONAME,STAT,XSTAT
S DVBABCNT=0
K ^TMP($J)
S (DA,DA(1),REQDA)=+ZREQDA
S (NAME,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE,ZIP,HOMPHON,BUSPHON,OTHDIS)=""
S (COUNTY,PROVINCE,POSTALCD,COUNTRY)=""
D VARS^DVBCUTIL
START ;
S ZMSG(DVBABCNT)=" COMPENSATION AND PENSION EXAM INQUIRY",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" -------------------------------------",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Name: "_PNAM,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" SSN: "_SSN,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" C-Number: "_CNUM,DVBABCNT=DVBABCNT+1
S Y=DOB X ^DD("DD")
S ZMSG(DVBABCNT)=" DOB: "_Y,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Address: "_ADR1,DVBABCNT=DVBABCNT+1
I ADR2'="" S ZMSG(DVBABCNT)=" "_ADR2,DVBABCNT=DVBABCNT+1
I ADR3'="" S ZMSG(DVBABCNT)=" "_ADR3,DVBABCNT=DVBABCNT+1
I $$ISFORGN^DVBCUTIL(COUNTRY)>0 D
. S ZMSG(DVBABCNT)="City,Province,Postal Code: "_CITY_", "_PROVINCE_" "_POSTALCD
. S DVBABCNT=DVBABCNT+1
E D
. S ZMSG(DVBABCNT)=" City,State,Zip+4: "_CITY_", "_STATE_" "_ZIP
. S DVBABCNT=DVBABCNT+1
I COUNTRY>0 D
. S ZMSG(DVBABCNT)=" Country: "_$$GETCNTRY^DVBCUTIL(COUNTRY)
. S DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Res Phone: "_HOMPHON,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Bus Phone: "_BUSPHON,DVBABCNT=DVBABCNT+1
S Y=EOD X ^DD("DD") S:Y="" Y="Not specified"
S ZMSG(DVBABCNT)=" Entered active service: "_Y,DVBABCNT=DVBABCNT+1
S Y=RAD X ^DD("DD") S:Y="" Y="Not specified"
S ZMSG(DVBABCNT)=" Released active service: "_Y,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1
D ^DVBAB97,^DVBAB68
S REQDT=$P(^DVB(396.3,REQDA,0),U,2)
S Y=REQDT X ^DD("DD")
S ZMSG(DVBABCNT)="This request was initiated on "_$P(Y,"@",1)_" at "_$P(Y,"@",2),DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="Requester: "_REQN,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="Requesting Regional Office: "_RONAME,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
I $D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="Exams on this request: ",DVBABCNT=DVBABCNT+1 D TST^DVBAB96
I '$D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="(No exams have yet been entered)",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
S (XSTAT,STAT)=$P(^DVB(396.3,REQDA,0),U,18)
S XSTAT=$$RSTAT^DVBCUTL8(STAT)
S STAT=$$RTSTAT^DVBCUTL8(STAT)
S ZMSG(DVBABCNT)="** Status of request: ",DVBABCNT=DVBABCNT+1
;S STAT=$S(XSTAT="N":"New",XSTAT="P":"Pending, reported to MAS",XSTAT="T":"Transcribed",XSTAT="S":"Scheduled",XSTAT="R":"Released, not printed",XSTAT="C":"Completed",XSTAT="CT":"Completed, transferred out",XSTAT="NT":"New, transferred in",1:"")
I STAT]"" S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1
I XSTAT="R"!(XSTAT="C") S Y=$P(^DVB(396.3,REQDA,0),U,14) X ^DD("DD") S RELBY=$P(^DVB(396.3,REQDA,0),U,15),RELBY=$S($D(^VA(200,+RELBY,0)):$P(^(0),U,1),1:"Unknown user") S ZMSG(DVBABCNT)="Released on "_Y_" by "_RELBY,DVBABCNT=DVBABCNT+1
I XSTAT="C" S Y=$P(^DVB(396.3,REQDA,0),U,16) X ^DD("DD") S PRBY=$P(^DVB(396.3,REQDA,0),U,17),PRBY=$S($D(^VA(200,+PRBY,0)):$P(^(0),U,1),1:"Unknown user") S ZMSG(DVBABCNT)="Printed by the RO on "_Y_" by "_PRBY,DVBABCNT=DVBABCNT+1
I STAT="" S STAT=$S(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown") S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1
I STAT["Cancelled" S CANDT=$P(^DVB(396.3,REQDA,0),U,19) S ZMSG(DVBABCNT)=" (Cancelled on "_$$FMTE^XLFDT(CANDT,"5DZ")_")",DVBABCNT=DVBABCNT+1
I $D(^DVB(396.3,REQDA,1)),$P(^(1),U,3)="Y" S ZMSG(DVBABCNT)="This request was faxed to the regional office.",DVBABCNT=DVBABCNT+1
S FEXAM=$P(^DVB(396.3,REQDA,0),U,9) I FEXAM="Y" S ZMSG(DVBABCNT)="*** Exams done on a FEE BASIS *** ",DVBABCNT=DVBABCNT+1 K FEXAM
S ZMSG(DVBABCNT)="--------------------------------------------------------------------------------",DVBABCNT=DVBABCNT+1
D DDIS
S ZMSG(DVBABCNT)="Other Disabilities: "_OTHDIS,DVBABCNT=DVBABCNT+1 I $D(^DVB(396.3,REQDA,1)) S ZMSG(DVBABCNT)=" "_OTHDIS1,DVBABCNT=DVBABCNT+1 S ZMSG(DVBABCNT)=" "_OTHDIS2,DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="General Remarks:",DVBABCNT=DVBABCNT+1
F LINE=0:0 S LINE=$O(^DVB(396.3,REQDA,2,LINE)) Q:LINE="" S ZMSG(DVBABCNT)=^(LINE,0),DVBABCNT=DVBABCNT+1
END K ^TMP($J),TSTA1,TSTAT,XCNP
Q
DDIS1 S ZMSG(DVBABCNT)=DX_" "_$J(PCT,3,0)_" %",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)=" Service-Connected? "_$S(SC=1:"Yes",1:"No")_" DX Code: "_DXCOD,DVBABCNT=DVBABCNT+1
Q
DDIS ;
I '$D(^DPT(DFN,.372)) S ZMSG(DVBABCNT)="No rated disabilities on file",DVBABCNT=DVBABCNT+1 Q
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
S ZMSG(DVBABCNT)="RATED DISABILITIES:",DVBABCNT=DVBABCNT+1
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
S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB70 5872 printed Nov 22, 2024@16:50:48 Page 2
DVBAB70 ;ALB/SPH - CAPRI C&P EXAM INQUIRY ;09/28/2009
+1 ;;2.7;AMIE;**35,42,57,136,143,149,193**;Apr 10, 1995;Build 84
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
STRT(ZMSG,DFN,ZREQDA) ;
+1 NEW DVBABCNT,REQDA,DA,X,Y,PNAM,NAME,DOB,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE
+2 NEW HOMPHON,BUSPHON,OTHDIS,OTHDIS1,OTHDIS2,COUNTY,PROVINCE,POSTALCD,COUNTRY
+3 NEW ZIP,CANDT,PRBY,RELBY,DX,DXCOD,DXNUM,JII,PCT,SC,EDTA,EOD,RAD,LINE
+4 NEW REQN,REQDT,RONAME,STAT,XSTAT
+5 SET DVBABCNT=0
+6 KILL ^TMP($JOB)
+7 SET (DA,DA(1),REQDA)=+ZREQDA
+8 SET (NAME,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE,ZIP,HOMPHON,BUSPHON,OTHDIS)=""
+9 SET (COUNTY,PROVINCE,POSTALCD,COUNTRY)=""
+10 DO VARS^DVBCUTIL
START ;
+1 SET ZMSG(DVBABCNT)=" COMPENSATION AND PENSION EXAM INQUIRY"
SET DVBABCNT=DVBABCNT+1
+2 SET ZMSG(DVBABCNT)=" -------------------------------------"
SET DVBABCNT=DVBABCNT+1
+3 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+4 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+5 SET ZMSG(DVBABCNT)=" Name: "_PNAM
SET DVBABCNT=DVBABCNT+1
+6 SET ZMSG(DVBABCNT)=" SSN: "_SSN
SET DVBABCNT=DVBABCNT+1
+7 SET ZMSG(DVBABCNT)=" C-Number: "_CNUM
SET DVBABCNT=DVBABCNT+1
+8 SET Y=DOB
XECUTE ^DD("DD")
+9 SET ZMSG(DVBABCNT)=" DOB: "_Y
SET DVBABCNT=DVBABCNT+1
+10 SET ZMSG(DVBABCNT)=" Address: "_ADR1
SET DVBABCNT=DVBABCNT+1
+11 IF ADR2'=""
SET ZMSG(DVBABCNT)=" "_ADR2
SET DVBABCNT=DVBABCNT+1
+12 IF ADR3'=""
SET ZMSG(DVBABCNT)=" "_ADR3
SET DVBABCNT=DVBABCNT+1
+13 IF $$ISFORGN^DVBCUTIL(COUNTRY)>0
Begin DoDot:1
+14 SET ZMSG(DVBABCNT)="City,Province,Postal Code: "_CITY_", "_PROVINCE_" "_POSTALCD
+15 SET DVBABCNT=DVBABCNT+1
End DoDot:1
+16 IF '$TEST
Begin DoDot:1
+17 SET ZMSG(DVBABCNT)=" City,State,Zip+4: "_CITY_", "_STATE_" "_ZIP
+18 SET DVBABCNT=DVBABCNT+1
End DoDot:1
+19 IF COUNTRY>0
Begin DoDot:1
+20 SET ZMSG(DVBABCNT)=" Country: "_$$GETCNTRY^DVBCUTIL(COUNTRY)
+21 SET DVBABCNT=DVBABCNT+1
End DoDot:1
+22 SET ZMSG(DVBABCNT)=" Res Phone: "_HOMPHON
SET DVBABCNT=DVBABCNT+1
+23 SET ZMSG(DVBABCNT)=" Bus Phone: "_BUSPHON
SET DVBABCNT=DVBABCNT+1
+24 SET Y=EOD
XECUTE ^DD("DD")
if Y=""
SET Y="Not specified"
+25 SET ZMSG(DVBABCNT)=" Entered active service: "_Y
SET DVBABCNT=DVBABCNT+1
+26 SET Y=RAD
XECUTE ^DD("DD")
if Y=""
SET Y="Not specified"
+27 SET ZMSG(DVBABCNT)=" Released active service: "_Y
SET DVBABCNT=DVBABCNT+1
+28 SET ZMSG(DVBABCNT)="================================================================================"
SET DVBABCNT=DVBABCNT+1
+29 DO ^DVBAB97
DO ^DVBAB68
+30 SET REQDT=$PIECE(^DVB(396.3,REQDA,0),U,2)
+31 SET Y=REQDT
XECUTE ^DD("DD")
+32 SET ZMSG(DVBABCNT)="This request was initiated on "_$PIECE(Y,"@",1)_" at "_$PIECE(Y,"@",2)
SET DVBABCNT=DVBABCNT+1
+33 SET ZMSG(DVBABCNT)="Requester: "_REQN
SET DVBABCNT=DVBABCNT+1
+34 SET ZMSG(DVBABCNT)="Requesting Regional Office: "_RONAME
SET DVBABCNT=DVBABCNT+1
+35 SET ZMSG(DVBABCNT)="VHA Division Processing Request: "_$PIECE($$SITE^VASITE(,$PIECE(^DVB(396.3,REQDA,1),U,4)),U,2)
SET DVBABCNT=DVBABCNT+1
+36 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+37 IF $DATA(^DVB(396.4,"C",REQDA))
SET ZMSG(DVBABCNT)="Exams on this request: "
SET DVBABCNT=DVBABCNT+1
DO TST^DVBAB96
+38 IF '$DATA(^DVB(396.4,"C",REQDA))
SET ZMSG(DVBABCNT)="(No exams have yet been entered)"
SET DVBABCNT=DVBABCNT+1
+39 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+40 SET (XSTAT,STAT)=$PIECE(^DVB(396.3,REQDA,0),U,18)
+41 SET XSTAT=$$RSTAT^DVBCUTL8(STAT)
+42 SET STAT=$$RTSTAT^DVBCUTL8(STAT)
+43 SET ZMSG(DVBABCNT)="** Status of request: "
SET DVBABCNT=DVBABCNT+1
+44 ;S STAT=$S(XSTAT="N":"New",XSTAT="P":"Pending, reported to MAS",XSTAT="T":"Transcribed",XSTAT="S":"Scheduled",XSTAT="R":"Released, not printed",XSTAT="C":"Completed",XSTAT="CT":"Completed, transferred out",XSTAT="NT":"New, transferred in",1:"")
+45 IF STAT]""
SET ZMSG(DVBABCNT)=STAT
SET DVBABCNT=DVBABCNT+1
+46 IF XSTAT="R"!(XSTAT="C")
SET Y=$PIECE(^DVB(396.3,REQDA,0),U,14)
XECUTE ^DD("DD")
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")
SET ZMSG(DVBABCNT)="Released on "_Y_" by "_RELBY
SET DVBABCNT=DVBABCNT+1
+47 IF XSTAT="C"
SET Y=$PIECE(^DVB(396.3,REQDA,0),U,16)
XECUTE ^DD("DD")
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")
SET ZMSG(DVBABCNT)="Printed by the RO on "_Y_" by "_PRBY
SET DVBABCNT=DVBABCNT+1
+48 IF STAT=""
SET STAT=$SELECT(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown")
SET ZMSG(DVBABCNT)=STAT
SET DVBABCNT=DVBABCNT+1
+49 IF STAT["Cancelled"
SET CANDT=$PIECE(^DVB(396.3,REQDA,0),U,19)
SET ZMSG(DVBABCNT)=" (Cancelled on "_$$FMTE^XLFDT(CANDT,"5DZ")_")"
SET DVBABCNT=DVBABCNT+1
+50 IF $DATA(^DVB(396.3,REQDA,1))
IF $PIECE(^(1),U,3)="Y"
SET ZMSG(DVBABCNT)="This request was faxed to the regional office."
SET DVBABCNT=DVBABCNT+1
+51 SET FEXAM=$PIECE(^DVB(396.3,REQDA,0),U,9)
IF FEXAM="Y"
SET ZMSG(DVBABCNT)="*** Exams done on a FEE BASIS *** "
SET DVBABCNT=DVBABCNT+1
KILL FEXAM
+52 SET ZMSG(DVBABCNT)="--------------------------------------------------------------------------------"
SET DVBABCNT=DVBABCNT+1
+53 DO DDIS
+54 SET ZMSG(DVBABCNT)="Other Disabilities: "_OTHDIS
SET DVBABCNT=DVBABCNT+1
IF $DATA(^DVB(396.3,REQDA,1))
SET ZMSG(DVBABCNT)=" "_OTHDIS1
SET DVBABCNT=DVBABCNT+1
SET ZMSG(DVBABCNT)=" "_OTHDIS2
SET DVBABCNT=DVBABCNT+1
+55 SET ZMSG(DVBABCNT)="General Remarks:"
SET DVBABCNT=DVBABCNT+1
+56 FOR LINE=0:0
SET LINE=$ORDER(^DVB(396.3,REQDA,2,LINE))
if LINE=""
QUIT
SET ZMSG(DVBABCNT)=^(LINE,0)
SET DVBABCNT=DVBABCNT+1
END KILL ^TMP($JOB),TSTA1,TSTAT,XCNP
+1 QUIT
DDIS1 SET ZMSG(DVBABCNT)=DX_" "_$JUSTIFY(PCT,3,0)_" %"
SET DVBABCNT=DVBABCNT+1
+1 SET ZMSG(DVBABCNT)=" Service-Connected? "_$SELECT(SC=1:"Yes",1:"No")_" DX Code: "_DXCOD
SET DVBABCNT=DVBABCNT+1
+2 QUIT
DDIS ;
+1 IF '$DATA(^DPT(DFN,.372))
SET ZMSG(DVBABCNT)="No rated disabilities on file"
SET DVBABCNT=DVBABCNT+1
QUIT
+2 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+3 SET ZMSG(DVBABCNT)="RATED DISABILITIES:"
SET DVBABCNT=DVBABCNT+1
+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 SET ZMSG(DVBABCNT)=""
SET DVBABCNT=DVBABCNT+1
+6 QUIT
