RTTR2 ;ALB/JLU - ;NOTICE OF TRANSFER OF VETERANS - 3/6/91
;;v 2.0;Record Tracking;;10/22/91
;
P1 W !,"| 12a. DATE OF TRANSFER",?27,"| 12b. REC. STAT NO.",?52,"| 12c. TRF. STA. NO.",?79,"|"
Q
;
P2 W !,"|",?5,RTPAST1,?27,"|",?36,RTSTNN,?52,"|",?62,RTDIV,?79,"|"
Q
;
DPT S RTNA1=U_$P(RTH,";",2)_$P(RTH,";")
S RTNA=@(RTNA1_",0)"),RTSS=$P(RTNA,U,9),RTNA=$P(RTNA,U)
I $D(@(RTNA1_",.31)")) S RTCN=$S($P(^(.31),U,3):$P(^(.31),U,3),1:"Unknown")
E S RTCN="Unknown"
I $D(@(RTNA1_",.32)")) S RTSN=$S($P(^(.32),U,8):$P(^(.32),U,8),1:"Unknown")
E S RTSN="Unknown"
Q
;
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)
;
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
;
EX K AR,RTH1,RTH
EX1 K DIR,DTOUT,DUOUT,N,RTCN,RTI,RTII,RTJ,RTNA,RTNA1,RTSN,RTSS,RTSTN,RTSTNN,Y,XMB,RTPAST1
Q
;
DSP K DUOUT,DTOUT
S Y=$P(^RTV(195.9,RTB,0),U) D NAM^RTTR1 S RTSTN=Y,RTSTNN=N
I "DPT("[$P(RTH,";",2) D DPT I 1
E S (RTNA,RTSS,RTCN,RTSN)=" "
S RTII="" F RTI=0:0 S RTI=$O(AR(RTH,RTI)) Q:'RTI S RTII=RTII_RTI
;
S IOP="HOME" D ^%ZIS K IOP
W @IOF S CT=1,XMB(CT)="NOTICE OF TRANSFER OF VETERANS RECORDS."
D PT^RTTR1
S CT=2,XMB(CT)=$J(RTSTN,27)_$J(RTSTNN,15) D WHOTO^RTTR1,INST^RTTR1
D PN^RTTR1
S CT=5,XMB(CT)=$J(RTNA,30)
D PN1^RTTR1,PN2^RTTR1
S CT=6,XMB(CT)=RTCN,XMB(CT+1)=RTSS
D PY5^RTTR1
S CT=8,XMB(CT)=RTSN
D PY6^RTTR1
K DTOUT,DUOUT
D Y8^RTTR11 I $D(DUOUT)!($D(DTOUT)) Q
D LINE^RTUTL3,P1
I '$D(RTPAST1) S Y=RTPAST D DD^%DT S RTPAST1=Y
S CT=14,XMB(CT)=RTPAST1,XMB(CT+1)=RTSTNN,XMB(CT+2)=RTDIV
D P2,LINE^RTUTL3
;S DIR("A")="| 12d. PAYEE NO. ",DIR(0)="NAO^0:99" D ^DIR
;I $D(DUOUT)!($D(DTOUT)) D EX Q
;W $C(13),DIR("A"),Y,?$X+60,"|"
;S CT=17,XMB(17)=Y
;D LINE^RTUTL3
S CT=21
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)
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)
;
D PY13D^RTTR11
S DIR("A")="| ["_XMB(21)_"] LG ["_XMB(22)_"] PG ["_XMB(23)_"] OPT ["_XMB(24)_"] REC ["_XMB(25)_"] CORRESP ["_XMB(26)_"] RAY Number(s) "
S DIR(0)="LOA^0:6" D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) Q
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
D PY13^RTTR11,PY13A^RTTR11
S DIR("A")="| ["_XMB(27)_"] R&E ["_XMB(28)_"] INS ["_XMB(29)_"] SUBFOLDER ["_XMB(30)_"] (specify) Number(s) "
S DIR(0)="LOA^7:10" D ^DIR I $D(DUOUT)!($D(DTOUT)) Q
F Z=7:1:10 S XMB(20+Z)=$S(Y[Z!(XMB(20+Z)["X"):"X",1:" ") ;hard set 20
S XMB(300)=""
D PY13B^RTTR11
I XMB(30)="X" K DIR S DIR("A")="| Specify: ",DIR(0)="FOA^1:30" D ^DIR S XMB(300)=Y
D L14^RTTR11 I $D(DUOUT)!($D(DTOUT)) Q
D L16^RTTR1,LINE^RTUTL3
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTTR2 2962 printed Oct 16, 2024@18:35:48 Page 2
RTTR2 ;ALB/JLU - ;NOTICE OF TRANSFER OF VETERANS - 3/6/91
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ;
P1 WRITE !,"| 12a. DATE OF TRANSFER",?27,"| 12b. REC. STAT NO.",?52,"| 12c. TRF. STA. NO.",?79,"|"
+1 QUIT
+2 ;
P2 WRITE !,"|",?5,RTPAST1,?27,"|",?36,RTSTNN,?52,"|",?62,RTDIV,?79,"|"
+1 QUIT
+2 ;
DPT SET RTNA1=U_$PIECE(RTH,";",2)_$PIECE(RTH,";")
+1 SET RTNA=@(RTNA1_",0)")
SET RTSS=$PIECE(RTNA,U,9)
SET RTNA=$PIECE(RTNA,U)
+2 IF $DATA(@(RTNA1_",.31)"))
SET RTCN=$SELECT($PIECE(^(.31),U,3):$PIECE(^(.31),U,3),1:"Unknown")
+3 IF '$TEST
SET RTCN="Unknown"
+4 IF $DATA(@(RTNA1_",.32)"))
SET RTSN=$SELECT($PIECE(^(.32),U,8):$PIECE(^(.32),U,8),1:"Unknown")
+5 IF '$TEST
SET RTSN="Unknown"
+6 QUIT
+7 ;
A FOR RTJ=0:0
SET RTJ=$ORDER(^TMP($JOB,"RT","XREF",RTJ))
if 'RTJ
QUIT
SET AR($PIECE(^RT(RTJ,0),U),$PIECE(^RT(RTJ,0),U,3))=^RT(RTJ,0)
+1 ;
+2 SET RTH=0
FOR RTH1=0:0
SET RTH=$ORDER(AR(RTH))
if 'RTH
QUIT
DO DSP
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
SET XMY(DUZ)=""
SET XMB="RT REQUEST/NOTICE TRANSFER"
DO ^XMB
DO EX1
+3 ;
EX KILL AR,RTH1,RTH
EX1 KILL DIR,DTOUT,DUOUT,N,RTCN,RTI,RTII,RTJ,RTNA,RTNA1,RTSN,RTSS,RTSTN,RTSTNN,Y,XMB,RTPAST1
+1 QUIT
+2 ;
DSP KILL DUOUT,DTOUT
+1 SET Y=$PIECE(^RTV(195.9,RTB,0),U)
DO NAM^RTTR1
SET RTSTN=Y
SET RTSTNN=N
+2 IF "DPT("[$PIECE(RTH,";",2)
DO DPT
IF 1
+3 IF '$TEST
SET (RTNA,RTSS,RTCN,RTSN)=" "
+4 SET RTII=""
FOR RTI=0:0
SET RTI=$ORDER(AR(RTH,RTI))
if 'RTI
QUIT
SET RTII=RTII_RTI
+5 ;
+6 SET IOP="HOME"
DO ^%ZIS
KILL IOP
+7 WRITE @IOF
SET CT=1
SET XMB(CT)="NOTICE OF TRANSFER OF VETERANS RECORDS."
+8 DO PT^RTTR1
+9 SET CT=2
SET XMB(CT)=$JUSTIFY(RTSTN,27)_$JUSTIFY(RTSTNN,15)
DO WHOTO^RTTR1
DO INST^RTTR1
+10 DO PN^RTTR1
+11 SET CT=5
SET XMB(CT)=$JUSTIFY(RTNA,30)
+12 DO PN1^RTTR1
DO PN2^RTTR1
+13 SET CT=6
SET XMB(CT)=RTCN
SET XMB(CT+1)=RTSS
+14 DO PY5^RTTR1
+15 SET CT=8
SET XMB(CT)=RTSN
+16 DO PY6^RTTR1
+17 KILL DTOUT,DUOUT
+18 DO Y8^RTTR11
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+19 DO LINE^RTUTL3
DO P1
+20 IF '$DATA(RTPAST1)
SET Y=RTPAST
DO DD^%DT
SET RTPAST1=Y
+21 SET CT=14
SET XMB(CT)=RTPAST1
SET XMB(CT+1)=RTSTNN
SET XMB(CT+2)=RTDIV
+22 DO P2
DO LINE^RTUTL3
+23 ;S DIR("A")="| 12d. PAYEE NO. ",DIR(0)="NAO^0:99" D ^DIR
+24 ;I $D(DUOUT)!($D(DTOUT)) D EX Q
+25 ;W $C(13),DIR("A"),Y,?$X+60,"|"
+26 ;S CT=17,XMB(17)=Y
+27 ;D LINE^RTUTL3
+28 SET CT=21
+29 SET XMB(CT)=$SELECT(RTII[99:"X",1:1)
SET XMB(CT+1)=$SELECT(RTII[98:"X",1:2)
SET XMB(CT+2)=$SELECT(RTII[97:"X",1:3)
SET XMB(CT+3)=$SELECT(RTII[1:"X",1:4)
SET XMB(CT+4)=$SELECT(RTII[2:"X",1:5)
SET XMB(CT+5)=$SELECT(RTII[96:"X",1:6)
+30 SET XMB(CT+6)=$SELECT(RTII[95:"X",1:7)
SET XMB(CT+7)=$SELECT(RTII[94:"X",1:8)
SET XMB(CT+8)=$SELECT(RTII[93:"X",1:9)
SET XMB(CT+9)=$SELECT(RTII[92:"X",1:10)
+31 ;
+32 DO PY13D^RTTR11
+33 SET DIR("A")="| ["_XMB(21)_"] LG ["_XMB(22)_"] PG ["_XMB(23)_"] OPT ["_XMB(24)_"] REC ["_XMB(25)_"] CORRESP ["_XMB(26)_"] RAY Number(s) "
+34 SET DIR(0)="LOA^0:6"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+35 ;hard set of 20 instead of CT
FOR Z=1:1:6
SET XMB(20+Z)=$SELECT(Y[Z!(XMB(20+Z)["X"):"X",1:" ")
+36 DO PY13^RTTR11
DO PY13A^RTTR11
+37 SET DIR("A")="| ["_XMB(27)_"] R&E ["_XMB(28)_"] INS ["_XMB(29)_"] SUBFOLDER ["_XMB(30)_"] (specify) Number(s) "
+38 SET DIR(0)="LOA^7:10"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+39 ;hard set 20
FOR Z=7:1:10
SET XMB(20+Z)=$SELECT(Y[Z!(XMB(20+Z)["X"):"X",1:" ")
+40 SET XMB(300)=""
+41 DO PY13B^RTTR11
+42 IF XMB(30)="X"
KILL DIR
SET DIR("A")="| Specify: "
SET DIR(0)="FOA^1:30"
DO ^DIR
SET XMB(300)=Y
+43 DO L14^RTTR11
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+44 DO L16^RTTR1
DO LINE^RTUTL3
+45 QUIT
