RTLDIV ;ISC-ALBANY/pke-look up 40.8 for select label print; 3/1/88 10:38 AM ;
;;v 2.0;Record Tracking;;10/22/91
; returns RTLDIV="^pt^pt^pt^"
S:'$D(DTIME) DTIME=300
S N=0 D LIST,ASK G Q
NAM S N=1 D LIST,ASK
Q K N,Z,I,RTS,RTY,RTRD,RTC,RTSEL,X Q
;
LIST S Z=0 F I=1:1 S Z=$O(^DG(40.8,"B",Z)) Q:Z="" S RTS(I)=Z_"^"_$O(^DG(40.8,"B",Z,0))
I I=1 W !,"No Divisions Defined" G Q
E W !,?7,"Selecting... Choose to Print by "_$S('N:"Terminal Digits for",N:"Name of patient for",1:"")
S RTS(I)="Patients with no Registration^"
S J=I F I=1:1:J W !,?10,I,?31,$P(RTS(I),"^")
Q
ASK S RTRD("S")="",RTSEL="S",RTRD(0)="",(RTCXX,RTC)=J
S RTRD("A")="Select Medical Center Division(s): "
D SEL^RTRD
I X S RTLDIV="^" F Z=0:0 S Z=$O(RTY(Z)) Q:'Z S RTLDIV=RTLDIV_$P(RTY(Z),"^",2)_"^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTLDIV 800 printed Dec 13, 2024@02:34 Page 2
RTLDIV ;ISC-ALBANY/pke-look up 40.8 for select label print; 3/1/88 10:38 AM ;
+1 ;;v 2.0;Record Tracking;;10/22/91
+2 ; returns RTLDIV="^pt^pt^pt^"
+3 if '$DATA(DTIME)
SET DTIME=300
+4 SET N=0
DO LIST
DO ASK
GOTO Q
NAM SET N=1
DO LIST
DO ASK
Q KILL N,Z,I,RTS,RTY,RTRD,RTC,RTSEL,X
QUIT
+1 ;
LIST SET Z=0
FOR I=1:1
SET Z=$ORDER(^DG(40.8,"B",Z))
if Z=""
QUIT
SET RTS(I)=Z_"^"_$ORDER(^DG(40.8,"B",Z,0))
+1 IF I=1
WRITE !,"No Divisions Defined"
GOTO Q
+2 IF '$TEST
WRITE !,?7,"Selecting... Choose to Print by "_$SELECT('N:"Terminal Digits for",N:"Name of patient for",1:"")
+3 SET RTS(I)="Patients with no Registration^"
+4 SET J=I
FOR I=1:1:J
WRITE !,?10,I,?31,$PIECE(RTS(I),"^")
+5 QUIT
ASK SET RTRD("S")=""
SET RTSEL="S"
SET RTRD(0)=""
SET (RTCXX,RTC)=J
+1 SET RTRD("A")="Select Medical Center Division(s): "
+2 DO SEL^RTRD
+3 IF X
SET RTLDIV="^"
FOR Z=0:0
SET Z=$ORDER(RTY(Z))
if 'Z
QUIT
SET RTLDIV=RTLDIV_$PIECE(RTY(Z),"^",2)_"^"
+4 QUIT
