source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTTR2.m@ 1806

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1RTTR2 ;ALB/JLU - ;NOTICE OF TRANSFER OF VETERANS - 3/6/91
2 ;;v 2.0;Record Tracking;;10/22/91
3 ;
4P1 W !,"| 12a. DATE OF TRANSFER",?27,"| 12b. REC. STAT NO.",?52,"| 12c. TRF. STA. NO.",?79,"|"
5 Q
6 ;
7P2 W !,"|",?5,RTPAST1,?27,"|",?36,RTSTNN,?52,"|",?62,RTDIV,?79,"|"
8 Q
9 ;
10DPT 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 ;
18A 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 ;
22EX K AR,RTH1,RTH
23EX1 K DIR,DTOUT,DUOUT,N,RTCN,RTI,RTII,RTJ,RTNA,RTNA1,RTSN,RTSS,RTSTN,RTSTNN,Y,XMB,RTPAST1
24 Q
25 ;
26DSP 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
Note: See TracBrowser for help on using the repository browser.