source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB70.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1DVBAB70 ;ALB/SPH - CAPRI C&P EXAM INQUIRY ;09/08/00
2 ;;2.7;AMIE;**35,42,57**;Apr 10, 1995
3 ;
4STRT(ZMSG,DFN,ZREQDA) ;
5 S DVBABCNT=0
6 K ^TMP($J) S Y=DT X ^DD("DD") S FDT(0)=Y D HOME^%ZIS S FF=IOF
7 S DIC="^DVB(396.3,"
8 S DIC(0)="M"
9 S DIC(1)=ZREQDA
10 S Y=ZREQDA
11 S JI=$P(Y,U,2),(DA,DA(1),REQDA)=+Y
12 S (NAME,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE,ZIP,HOMPHON,BUSPHON,OTHDIS)=""
13 D VARS^DVBCUTIL
14 G START
15CON ;
16 I IOST?1"P-".E,$Y>45 W @IOF D HDR
17 Q
18START S PGHD="",PG=0
19 S ZMSG(DVBABCNT)=" COMPENSATION AND PENSION EXAM INQUIRY",DVBABCNT=DVBABCNT+1
20 S ZMSG(DVBABCNT)=" -------------------------------------",DVBABCNT=DVBABCNT+1
21 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
22 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
23 S ZMSG(DVBABCNT)=" Name: "_PNAM,DVBABCNT=DVBABCNT+1
24 S ZMSG(DVBABCNT)=" SSN: "_SSN,DVBABCNT=DVBABCNT+1
25 S ZMSG(DVBABCNT)=" C-Number: "_CNUM,DVBABCNT=DVBABCNT+1
26 S Y=DOB X ^DD("DD")
27 S ZMSG(DVBABCNT)=" DOB: "_Y,DVBABCNT=DVBABCNT+1
28 S ZMSG(DVBABCNT)=" Address: "_ADR1,DVBABCNT=DVBABCNT+1
29 I ADR2'="" S ZMSG(DVBABCNT)=" "_ADR2,DVBABCNT=DVBABCNT+1
30 I ADR3'="" S ZMSG(DVBABCNT)=" "_ADR3,DVBABCNT=DVBABCNT+1
31 S ZMSG(DVBABCNT)="City,State,Zip+4: "_CITY_", "_STATE_" "_ZIP,DVBABCNT=DVBABCNT+1
32 S ZMSG(DVBABCNT)=" Res Phone: "_HOMPHON,DVBABCNT=DVBABCNT+1
33 S ZMSG(DVBABCNT)=" Bus Phone: "_BUSPHON,DVBABCNT=DVBABCNT+1
34 S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7)
35 S Y=EOD X ^DD("DD") S:Y="" Y="Not specified"
36 S ZMSG(DVBABCNT)="Entered active service: "_Y,DVBABCNT=DVBABCNT+1
37 S Y=RAD X ^DD("DD") S:Y="" Y="Not specified"
38 S ZMSG(DVBABCNT)="Released active service: "_Y,DVBABCNT=DVBABCNT+1
39 S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1
40 W !! D CON Q:$D(OUT) D ^DVBAB97,CON Q:$D(OUT) D ^DVBAB68,CON Q:$D(OUT) S REQDT=$P(^DVB(396.3,REQDA,0),U,2)
41 S Y=REQDT X ^DD("DD")
42 S ZMSG(DVBABCNT)="This request was initiated on "_$P(Y,"@",1)_" at "_$P(Y,"@",2),DVBABCNT=DVBABCNT+1
43 S ZMSG(DVBABCNT)="Requester: "_REQN,DVBABCNT=DVBABCNT+1
44 S ZMSG(DVBABCNT)="Requesting Regional Office: "_RONAME,DVBABCNT=DVBABCNT+1
45 S ZMSG(DVBABCNT)="VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),DVBABCNT=DVBABCNT+1
46 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
47 I $D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="Exams on this request: ",DVBABCNT=DVBABCNT+1 D TST^DVBAB96 ;DVBCUTL2
48 I '$D(^DVB(396.4,"C",REQDA)) S ZMSG(DVBABCNT)="(No exams have yet been entered)",DVBABCNT=DVBABCNT+1
49 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
50 S ZMSG(DVBABCNT)="** Status of request: ",DVBABCNT=DVBABCNT+1
51 S (XSTAT,STAT)=$P(^DVB(396.3,REQDA,0),U,18)
52 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:"")
53 I STAT]"" S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1
54 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
55 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
56 I STAT="" S STAT=$S(XSTAT="X":"Cancelled by MAS",XSTAT="RX":"Cancelled by RO",1:"Unknown") S ZMSG(DVBABCNT)=STAT,DVBABCNT=DVBABCNT+1
57 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
58 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
59 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
60 S ZMSG(DVBABCNT)="--------------------------------------------------------------------------------",DVBABCNT=DVBABCNT+1
61 D DDIS Q:$D(OUT) D CON Q:$D(OUT)
62 I IOST?1"P-".E,$Y>45 W @IOF D HDR
63 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
64 S ZMSG(DVBABCNT)="General Remarks:",DVBABCNT=DVBABCNT+1
65 K ^UTILITY($J,"W")
66 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 S ZMSG(DVBABCNT)=X,DVBABCNT=DVBABCNT+1 ;I IOST?1"C-".E,$Y>19 D CON ;W !!,"General Remarks, continued",!!!
67END K ^TMP($J),TSTA1,TSTAT,XCNP
68 Q
69DDIS1 S ZMSG(DVBABCNT)=DX_" "_$J(PCT,3,0)_" %",DVBABCNT=DVBABCNT+1
70 S ZMSG(DVBABCNT)=" Service-Connected? "_$S(SC=1:"Yes",1:"No")_" DX Code: "_DXCOD,DVBABCNT=DVBABCNT+1
71 I $Y>19 D CON
72 Q
73DDIS I $Y>12 D CON Q:$D(OUT)
74 I '$D(^DPT(DFN,.372)) S ZMSG(DVBABCNT)="No rated disabilities on file",DVBABCNT=DVBABCNT+1 Q
75 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
76 S ZMSG(DVBABCNT)="RATED DISABILITIES:",DVBABCNT=DVBABCNT+1
77 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
78 S ZMSG(DVBABCNT)="",DVBABCNT=DVBABCNT+1
79 Q
80HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF
81 S ZMSG(DVBABCNT)="================================================================================",DVBABCNT=DVBABCNT+1
82 Q
Note: See TracBrowser for help on using the repository browser.