Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RTTR2

RTTR2.m

Go to the documentation of this file.
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