RTTR11 ;ALB/PKE,JLU - THE SECOND HALF OF RTTR1 ; 3/6/91
;;v 2.0;Record Tracking;;10/22/91
;
PY8 W $C(13),"| 8. TYPE OF TRANSFER [",XMB(CT),"] Permanent [",XMB(CT+1),"] Temporary",?$X+28,"|"
Q
;
PY11 W $C(13),"| 11a. Transfer Claims Folder [",XMB(CT),"] CL",?$X+41,"|"
Q
PY13 W $C(13),"| [",XMB(CT),"] LG [",XMB(CT+1),"] PG [",XMB(CT+2),"] OPT [",XMB(CT+3),"] REC [",XMB(CT+4),"] CORRESP [",XMB(CT+5),"] RAY",?$X+23,"|"
Q
;
PY13A W !,"|",?79,"|",!,"|",?24,"COUNSELING/TRAINING",?79,"|"
Q
;
PY13B W $C(13),"| [",XMB(CT+6),"] R&E [",XMB(CT+7),"] INS [",XMB(CT+8),"] SUBFOLDER [",XMB(CT+9),"] (specify)",?$X+31,"|"
Q
;
PY13C W !,"| Specify:",XMB(300)
Q
;
PY13D W !,"| 13. OTHER FOLDER TRANSFER",?$X+51,"|"
W !,"|",?31,"MED",?40,"HOSP",?53,"X-",?79,"|"
Q
;
PL14 W !,"| 14. Reason for Transfer or Remarks",?79,"|"
Q
;
PL14A I XMB(CT)="" W $C(13),"| ",?$X+74,"|"
E W $C(13),"| ",XMB(CT)
Q
;
PL14B I XMB(CT+1)="" W $C(13),"| ",?$X+74,"|"
E W $C(13),"| ",XMB(CT+1)
Q
;
PL15 W $C(13),"| 15. Adjudication Action pending [",XMB(CT),"] YES [",XMB(CT+1),"] NO",?$X+27,"|"
Q
;
Y7 S CT=9
;7 beneficary master record NOT USED
I RTVAR['7
E S DIR("A")="",DIR(0)="" D ^DIR K DIR I 0
E S XMB(CT)="X"
;
Y8 ;8 TYPE OF TRANSFER
S CT=10 D LINE^RTUTL3
;A nothing added to prompt, B choices added
S (RTV,DIR("A"))="| 8. TYPE OF TRANSFER [ ] Permanent [ ] Temporary ? ",DIR("B")="T",DIR(0)="SOA^P:Permanent;T:Temporary"
D ^DIR K DIR I $D(DUOUT)!($D(DTOUT)) Q
S XMB(CT)=$S(Y="P":"X",1:"")
S XMB(CT+1)=$S(Y="T":"X",1:"")
D PY8
Q:$D(RTKEY)
;
Y9 ;9 other file number logic for not used fields
S CT=11
I RTVAR'[9
E S DIR("A")="9. Other File NO. ? ",DIR(0)="FOA^1:20" D ^DIR K DIR I 0
E S XMB(CT)=Y
;
Y11 ;11 TRANSFER CLAIMS FOLDER
S CT=12 D LINE^RTUTL3
S (RTV,DIR("A"))="| 11a. Transfer Claims Folder [ ] CL ? ",DIR("B")="NO",DIR(0)="YOA^"
D ^DIR K DIR I $D(DUOUT)!($D(RTOUT)) Q
S XMB(CT)=$S(Y=1:"X",1:" ")
D PY11
;
Y11B ;11B Transfer DEA folder not used
S CT=13
I RTVAR'[9
E S DIR("A")="| 11b. Transfer DEA folder ?",DIR("B")="",DIR(0)="YOA^" D ^DIR K DIR I 0
E S XMB(CT)="X"
;
Y12 ;12A date of transfer, 12b rec station, 12c tranf station, 12 d paye no
;only appears after a transfer to
;S CT=14
;
Y13 ;13 other folder transfer
S CT=21 D LINE^RTUTL3
F Z=CT:1:CT+9 S XMB(CT)=" "
D PY13D
S DIR("A")="| [1] LG [2] PG [3] OPT [4] REC [5] CORRESP [6] 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:"X",1:" ") ;hard set of 20 instead of CT
D PY13,PY13A
S DIR("A")="| [7] R&E [8] INS [9] SUBFOLDER [10] (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:"X",1:" ") ;hard set 20
S XMB(300)=""
D PY13B
I XMB(30)="X" K DIR S DIR("A")="| Specify:",DIR(0)="FOA^1:30" D ^DIR S XMB(300)=Y
S CT=1 D PT^RTTR1
S CT=2 D PN^RTTR1
S CT=5 D PN1^RTTR1,PN2^RTTR1
S CT=6 D PY5^RTTR1
S CT=8 D PY6^RTTR1
S CT=10 D LINE^RTUTL3 W ! D PY8
S CT=12 D LINE^RTUTL3 W ! D PY11
S CT=21 D LINE^RTUTL3,PY13D W ! D PY13,PY13A W ! D PY13B,PY13C
;
L14 ;14 reason transfer/or remarks
S CT=31
D LINE^RTUTL3,PL14
S DIR("A")="| ",DIR(0)="FOA^1:70" D ^DIR I $D(DUOUT)!($D(DTOUT)) Q
S XMB(CT)=Y K Y
D PL14A
I X'="" S DIR("A")="| " D ^DIR I $D(DUOUT)!($D(DTOUT)) Q
S XMB(CT+1)=$S($D(Y):Y,1:"")
D PL14B K DIR
I $D(RTKEY) Q
L15 ;15 ajudication action pending ?
S CT=33
D LINE^RTUTL3
S DIR("A")="| 15. Adjudication Action pending [Y] YES [N] NO ? ",DIR("B")="NO",DIR(0)="YOA^"
D ^DIR I $D(DUOUT)!($D(DTOUT)) Q
S XMB(CT)=$S(Y=1:"X",1:"")
S XMB(CT+1)=$S('Y:"X",1:"")
D PL15
K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTTR11 3804 printed Nov 22, 2024@17:45:03 Page 2
RTTR11 ;ALB/PKE,JLU - THE SECOND HALF OF RTTR1 ; 3/6/91
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ;
PY8 WRITE $CHAR(13),"| 8. TYPE OF TRANSFER [",XMB(CT),"] Permanent [",XMB(CT+1),"] Temporary",?$X+28,"|"
+1 QUIT
+2 ;
PY11 WRITE $CHAR(13),"| 11a. Transfer Claims Folder [",XMB(CT),"] CL",?$X+41,"|"
+1 QUIT
PY13 WRITE $CHAR(13),"| [",XMB(CT),"] LG [",XMB(CT+1),"] PG [",XMB(CT+2),"] OPT [",XMB(CT+3),"] REC [",XMB(CT+4),"] CORRESP [",XMB(CT+5),"] RAY",?$X+23,"|"
+1 QUIT
+2 ;
PY13A WRITE !,"|",?79,"|",!,"|",?24,"COUNSELING/TRAINING",?79,"|"
+1 QUIT
+2 ;
PY13B WRITE $CHAR(13),"| [",XMB(CT+6),"] R&E [",XMB(CT+7),"] INS [",XMB(CT+8),"] SUBFOLDER [",XMB(CT+9),"] (specify)",?$X+31,"|"
+1 QUIT
+2 ;
PY13C WRITE !,"| Specify:",XMB(300)
+1 QUIT
+2 ;
PY13D WRITE !,"| 13. OTHER FOLDER TRANSFER",?$X+51,"|"
+1 WRITE !,"|",?31,"MED",?40,"HOSP",?53,"X-",?79,"|"
+2 QUIT
+3 ;
PL14 WRITE !,"| 14. Reason for Transfer or Remarks",?79,"|"
+1 QUIT
+2 ;
PL14A IF XMB(CT)=""
WRITE $CHAR(13),"| ",?$X+74,"|"
+1 IF '$TEST
WRITE $CHAR(13),"| ",XMB(CT)
+2 QUIT
+3 ;
PL14B IF XMB(CT+1)=""
WRITE $CHAR(13),"| ",?$X+74,"|"
+1 IF '$TEST
WRITE $CHAR(13),"| ",XMB(CT+1)
+2 QUIT
+3 ;
PL15 WRITE $CHAR(13),"| 15. Adjudication Action pending [",XMB(CT),"] YES [",XMB(CT+1),"] NO",?$X+27,"|"
+1 QUIT
+2 ;
Y7 SET CT=9
+1 ;7 beneficary master record NOT USED
+2 IF RTVAR['7
+3 IF '$TEST
SET DIR("A")=""
SET DIR(0)=""
DO ^DIR
KILL DIR
IF 0
+4 IF '$TEST
SET XMB(CT)="X"
+5 ;
Y8 ;8 TYPE OF TRANSFER
+1 SET CT=10
DO LINE^RTUTL3
+2 ;A nothing added to prompt, B choices added
+3 SET (RTV,DIR("A"))="| 8. TYPE OF TRANSFER [ ] Permanent [ ] Temporary ? "
SET DIR("B")="T"
SET DIR(0)="SOA^P:Permanent;T:Temporary"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 SET XMB(CT)=$SELECT(Y="P":"X",1:"")
+6 SET XMB(CT+1)=$SELECT(Y="T":"X",1:"")
+7 DO PY8
+8 if $DATA(RTKEY)
QUIT
+9 ;
Y9 ;9 other file number logic for not used fields
+1 SET CT=11
+2 IF RTVAR'[9
+3 IF '$TEST
SET DIR("A")="9. Other File NO. ? "
SET DIR(0)="FOA^1:20"
DO ^DIR
KILL DIR
IF 0
+4 IF '$TEST
SET XMB(CT)=Y
+5 ;
Y11 ;11 TRANSFER CLAIMS FOLDER
+1 SET CT=12
DO LINE^RTUTL3
+2 SET (RTV,DIR("A"))="| 11a. Transfer Claims Folder [ ] CL ? "
SET DIR("B")="NO"
SET DIR(0)="YOA^"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(RTOUT))
QUIT
+4 SET XMB(CT)=$SELECT(Y=1:"X",1:" ")
+5 DO PY11
+6 ;
Y11B ;11B Transfer DEA folder not used
+1 SET CT=13
+2 IF RTVAR'[9
+3 IF '$TEST
SET DIR("A")="| 11b. Transfer DEA folder ?"
SET DIR("B")=""
SET DIR(0)="YOA^"
DO ^DIR
KILL DIR
IF 0
+4 IF '$TEST
SET XMB(CT)="X"
+5 ;
Y12 ;12A date of transfer, 12b rec station, 12c tranf station, 12 d paye no
+1 ;only appears after a transfer to
+2 ;S CT=14
+3 ;
Y13 ;13 other folder transfer
+1 SET CT=21
DO LINE^RTUTL3
+2 FOR Z=CT:1:CT+9
SET XMB(CT)=" "
+3 DO PY13D
+4 SET DIR("A")="| [1] LG [2] PG [3] OPT [4] REC [5] CORRESP [6] RAY Number(s) "
+5 SET DIR(0)="LOA^0:6"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+6 ;hard set of 20 instead of CT
FOR Z=1:1:6
SET XMB(20+Z)=$SELECT(Y[Z:"X",1:" ")
+7 DO PY13
DO PY13A
+8 SET DIR("A")="| [7] R&E [8] INS [9] SUBFOLDER [10] (specify) Number(s) "
+9 SET DIR(0)="LOA^7:10"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+10 ;hard set 20
FOR Z=7:1:10
SET XMB(20+Z)=$SELECT(Y[Z:"X",1:" ")
+11 SET XMB(300)=""
+12 DO PY13B
+13 IF XMB(30)="X"
KILL DIR
SET DIR("A")="| Specify:"
SET DIR(0)="FOA^1:30"
DO ^DIR
SET XMB(300)=Y
+14 SET CT=1
DO PT^RTTR1
+15 SET CT=2
DO PN^RTTR1
+16 SET CT=5
DO PN1^RTTR1
DO PN2^RTTR1
+17 SET CT=6
DO PY5^RTTR1
+18 SET CT=8
DO PY6^RTTR1
+19 SET CT=10
DO LINE^RTUTL3
WRITE !
DO PY8
+20 SET CT=12
DO LINE^RTUTL3
WRITE !
DO PY11
+21 SET CT=21
DO LINE^RTUTL3
DO PY13D
WRITE !
DO PY13
DO PY13A
WRITE !
DO PY13B
DO PY13C
+22 ;
L14 ;14 reason transfer/or remarks
+1 SET CT=31
+2 DO LINE^RTUTL3
DO PL14
+3 SET DIR("A")="| "
SET DIR(0)="FOA^1:70"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+4 SET XMB(CT)=Y
KILL Y
+5 DO PL14A
+6 IF X'=""
SET DIR("A")="| "
DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+7 SET XMB(CT+1)=$SELECT($DATA(Y):Y,1:"")
+8 DO PL14B
KILL DIR
+9 IF $DATA(RTKEY)
QUIT
L15 ;15 ajudication action pending ?
+1 SET CT=33
+2 DO LINE^RTUTL3
+3 SET DIR("A")="| 15. Adjudication Action pending [Y] YES [N] NO ? "
SET DIR("B")="NO"
SET DIR(0)="YOA^"
+4 DO ^DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+5 SET XMB(CT)=$SELECT(Y=1:"X",1:"")
+6 SET XMB(CT+1)=$SELECT('Y:"X",1:"")
+7 DO PL15
+8 KILL DIR
+9 QUIT
