1 | RTTR2 ;ALB/JLU - ;NOTICE OF TRANSFER OF VETERANS - 3/6/91
|
---|
2 | ;;v 2.0;Record Tracking;;10/22/91
|
---|
3 | ;
|
---|
4 | P1 W !,"| 12a. DATE OF TRANSFER",?27,"| 12b. REC. STAT NO.",?52,"| 12c. TRF. STA. NO.",?79,"|"
|
---|
5 | Q
|
---|
6 | ;
|
---|
7 | P2 W !,"|",?5,RTPAST1,?27,"|",?36,RTSTNN,?52,"|",?62,RTDIV,?79,"|"
|
---|
8 | Q
|
---|
9 | ;
|
---|
10 | DPT S RTNA1=U_$P(RTH,";",2)_$P(RTH,";")
|
---|
11 | S RTNA=@(RTNA1_",0)"),RTSS=$P(RTNA,U,9),RTNA=$P(RTNA,U)
|
---|
12 | I $D(@(RTNA1_",.31)")) S RTCN=$S($P(^(.31),U,3):$P(^(.31),U,3),1:"Unknown")
|
---|
13 | E S RTCN="Unknown"
|
---|
14 | I $D(@(RTNA1_",.32)")) S RTSN=$S($P(^(.32),U,8):$P(^(.32),U,8),1:"Unknown")
|
---|
15 | E S RTSN="Unknown"
|
---|
16 | Q
|
---|
17 | ;
|
---|
18 | A F RTJ=0:0 S RTJ=$O(^TMP($J,"RT","XREF",RTJ)) Q:'RTJ S AR($P(^RT(RTJ,0),U),$P(^RT(RTJ,0),U,3))=^RT(RTJ,0)
|
---|
19 | ;
|
---|
20 | S RTH=0 F RTH1=0:0 S RTH=$O(AR(RTH)) Q:'RTH D DSP I '$D(DTOUT),'$D(DUOUT) S XMY(DUZ)="",XMB="RT REQUEST/NOTICE TRANSFER" D ^XMB,EX1
|
---|
21 | ;
|
---|
22 | EX K AR,RTH1,RTH
|
---|
23 | EX1 K DIR,DTOUT,DUOUT,N,RTCN,RTI,RTII,RTJ,RTNA,RTNA1,RTSN,RTSS,RTSTN,RTSTNN,Y,XMB,RTPAST1
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | DSP K DUOUT,DTOUT
|
---|
27 | S Y=$P(^RTV(195.9,RTB,0),U) D NAM^RTTR1 S RTSTN=Y,RTSTNN=N
|
---|
28 | I "DPT("[$P(RTH,";",2) D DPT I 1
|
---|
29 | E S (RTNA,RTSS,RTCN,RTSN)=" "
|
---|
30 | S RTII="" F RTI=0:0 S RTI=$O(AR(RTH,RTI)) Q:'RTI S RTII=RTII_RTI
|
---|
31 | ;
|
---|
32 | S IOP="HOME" D ^%ZIS K IOP
|
---|
33 | W @IOF S CT=1,XMB(CT)="NOTICE OF TRANSFER OF VETERANS RECORDS."
|
---|
34 | D PT^RTTR1
|
---|
35 | S CT=2,XMB(CT)=$J(RTSTN,27)_$J(RTSTNN,15) D WHOTO^RTTR1,INST^RTTR1
|
---|
36 | D PN^RTTR1
|
---|
37 | S CT=5,XMB(CT)=$J(RTNA,30)
|
---|
38 | D PN1^RTTR1,PN2^RTTR1
|
---|
39 | S CT=6,XMB(CT)=RTCN,XMB(CT+1)=RTSS
|
---|
40 | D PY5^RTTR1
|
---|
41 | S CT=8,XMB(CT)=RTSN
|
---|
42 | D PY6^RTTR1
|
---|
43 | K DTOUT,DUOUT
|
---|
44 | D Y8^RTTR11 I $D(DUOUT)!($D(DTOUT)) Q
|
---|
45 | D LINE^RTUTL3,P1
|
---|
46 | I '$D(RTPAST1) S Y=RTPAST D DD^%DT S RTPAST1=Y
|
---|
47 | S CT=14,XMB(CT)=RTPAST1,XMB(CT+1)=RTSTNN,XMB(CT+2)=RTDIV
|
---|
48 | D P2,LINE^RTUTL3
|
---|
49 | ;S DIR("A")="| 12d. PAYEE NO. ",DIR(0)="NAO^0:99" D ^DIR
|
---|
50 | ;I $D(DUOUT)!($D(DTOUT)) D EX Q
|
---|
51 | ;W $C(13),DIR("A"),Y,?$X+60,"|"
|
---|
52 | ;S CT=17,XMB(17)=Y
|
---|
53 | ;D LINE^RTUTL3
|
---|
54 | S CT=21
|
---|
55 | S XMB(CT)=$S(RTII[99:"X",1:1),XMB(CT+1)=$S(RTII[98:"X",1:2),XMB(CT+2)=$S(RTII[97:"X",1:3),XMB(CT+3)=$S(RTII[1:"X",1:4),XMB(CT+4)=$S(RTII[2:"X",1:5),XMB(CT+5)=$S(RTII[96:"X",1:6)
|
---|
56 | S XMB(CT+6)=$S(RTII[95:"X",1:7),XMB(CT+7)=$S(RTII[94:"X",1:8),XMB(CT+8)=$S(RTII[93:"X",1:9),XMB(CT+9)=$S(RTII[92:"X",1:10)
|
---|
57 | ;
|
---|
58 | D PY13D^RTTR11
|
---|
59 | S DIR("A")="| ["_XMB(21)_"] LG ["_XMB(22)_"] PG ["_XMB(23)_"] OPT ["_XMB(24)_"] REC ["_XMB(25)_"] CORRESP ["_XMB(26)_"] RAY Number(s) "
|
---|
60 | S DIR(0)="LOA^0:6" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) Q
|
---|
61 | F Z=1:1:6 S XMB(20+Z)=$S(Y[Z!(XMB(20+Z)["X"):"X",1:" ") ;hard set of 20 instead of CT
|
---|
62 | D PY13^RTTR11,PY13A^RTTR11
|
---|
63 | S DIR("A")="| ["_XMB(27)_"] R&E ["_XMB(28)_"] INS ["_XMB(29)_"] SUBFOLDER ["_XMB(30)_"] (specify) Number(s) "
|
---|
64 | S DIR(0)="LOA^7:10" D ^DIR I $D(DUOUT)!($D(DTOUT)) Q
|
---|
65 | F Z=7:1:10 S XMB(20+Z)=$S(Y[Z!(XMB(20+Z)["X"):"X",1:" ") ;hard set 20
|
---|
66 | S XMB(300)=""
|
---|
67 | D PY13B^RTTR11
|
---|
68 | I XMB(30)="X" K DIR S DIR("A")="| Specify: ",DIR(0)="FOA^1:30" D ^DIR S XMB(300)=Y
|
---|
69 | D L14^RTTR11 I $D(DUOUT)!($D(DTOUT)) Q
|
---|
70 | D L16^RTTR1,LINE^RTUTL3
|
---|
71 | Q
|
---|