source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCENQ1.m@ 1516

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

initial load of FOIAVistA 6/30/08 version
File size: 3.9 KB
Line 
1DVBCENQ1 ;ALB/GTS-557/THM 2507 INQUIRY DISPLAY ; 5/25/91 1:52 PM
2 ;;2.7;AMIE;**17,57**;Apr 10, 1995
3 ;
4 G START
5CON 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
6 I IOST?1"P-".E,$Y>45 W @IOF D HDR
7 Q
8 ;
9START S PGHD="COMPENSATION AND PENSION EXAM INQUIRY",PG=0
10 D HDR
11 W !!?2,"Name: ",PNAM,?56,"SSN: ",SSN,!?51,"C-Number: ",CNUM,!?56,"DOB: " S Y=DOB X ^DD("DD") W Y,!?2,"Address: ",ADR1,! W:ADR2]"" ?11,ADR2,! W:ADR3]"" ?11,ADR3,!!
12 W !?2,"City,State,Zip+4: ",?48,"Res Phone: ",HOMPHON,!?5,CITY," ",STATE," ",ZIP,?48,"Bus Phone: ",BUSPHON,!
13 S EDTA=$S($D(^DPT(DFN,.32)):^(.32),1:""),EOD=$P(EDTA,U,6),RAD=$P(EDTA,U,7)
14 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,!
15 F LINE=1:1:80 W "="
16 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)
17 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,!
18 W "VHA Division Processing Request: "_$P($$SITE^VASITE(,$P(^DVB(396.3,REQDA,1),U,4)),U,2),!
19 I $D(^DVB(396.4,"C",REQDA)) W !?3,"Exams on this request: " D TST^DVBCUTL2 W !
20 I '$D(^DVB(396.4,"C",REQDA)) W !?3,"(No exams have yet been entered)",!
21 W !,"** Status of request: " S (XSTAT,STAT)=$P(^DVB(396.3,REQDA,0),U,18)
22 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:"")
23 I STAT]"" W STAT
24 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,!
25 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,!
26 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"),")"
27 ;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.",!
28 I $D(^DVB(396.3,REQDA,1)),$P(^(1),U,3)="Y" W !,"This request was faxed to the regional office.",!
29 S FEXAM=$P(^DVB(396.3,REQDA,0),U,9) I FEXAM="Y" W !!,"*** Exams done on a FEE BASIS *** ",! K FEXAM
30 W ! F LINE=1:1:79 W "-"
31 W ! D DDIS Q:$D(OUT) D CON Q:$D(OUT)
32 I IOST?1"P-".E,$Y>45 W @IOF D HDR
33 W !!,"Other Disabilities:",!!?2,OTHDIS,! I $D(^DVB(396.3,REQDA,1)) W ?2,OTHDIS1,!?2,OTHDIS2
34 W !!,"General Remarks:",!!
35 K ^UTILITY($J,"W")
36 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",!!!
37 D ^DIWW
38END 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
39 Q
40 ;
41DDIS1 W ?2,DX,?37,$J(PCT,3,0)," %",?50,$S(SC=1:"Yes",1:"No"),?58,DXCOD,!
42 I $Y>19 D CON
43 Q
44 ;
45DDIS I $Y>12 D CON Q:$D(OUT)
46 I '$D(^DPT(DFN,.372)) W !?25,"No rated disabilities on file",!! Q
47 W !?2,"Rated Disability",?37,"Percent",?50,"SC ?",?58,"Dx Code",! W ?2 F LINE=1:1:63 W "-"
48 W !!
49 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
50 W !!
51 Q
52 ;
53HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF
54 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
55 W ! F XLINE=1:1:80 W "="
56 W ! Q
Note: See TracBrowser for help on using the repository browser.