RGUTUSR ;CAIRO/DKM - Parse recipient list;04-Sep-1998 11:26;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
;=================================================================
; Takes a list of recipients (which may be DUZ #'s, names,
; mail groups, or special tokens) as input and produces an
; array of DUZ's as output. If a list element is found in
; in the token list RGLST, the value of the token entry will
; be substituted.
; Inputs:
; RGUSR = Semicolon-delimited list of recipients
; RGLST = Special token list
; Outputs:
; RGOUT = Local array to receive DUZ list
;=================================================================
ENTRY(RGUSR,RGOUT,RGLST) ;
N RGZ,RGZ1,RGZ2
K RGOUT
F RGZ=1:1:$L(RGUSR,";") S RGZ1=$P(RGUSR,";",RGZ) D:RGZ1'="" S:RGZ1 RGOUT(+RGZ1)=""
.S:$D(RGLST(RGZ1)) RGZ1=RGLST(RGZ1)
.Q:RGZ1?.N
.I RGZ1?1"-"1.N D MGRP(-RGZ1) S RGZ1=0 Q
.S RGZ2=$E(RGZ1,1,2)
.I RGZ2="G." D MGRP($E(RGZ1,3,999)) Q
.I RGZ2="L." D LIST($E(RGZ1,3,999)) Q
.S RGZ1=$$LKP(RGZ1)
Q
LKP(RGNAME) ;
N RGZ,RGZ1
I $D(^VA(200,"B",RGNAME)) S RGZ=RGNAME G L1
S RGZ=$O(^(RGNAME)),RGZ1=$O(^(RGZ))
Q:(RGZ="")!(RGNAME'=$E(RGZ,1,$L(RGNAME))) 0
Q:(RGZ1'="")&(RGNAME=$E(RGZ1,1,$L(RGNAME))) 0
L1 S RGZ1=$O(^(RGZ,0)),RGZ=$O(^(RGZ1))
Q:'RGZ1!RGZ 0
Q RGZ1
LIST(RGLIST) ;
Q:RGLIST=""
S:RGLIST'=+RGLIST RGLIST=+$O(^RGCDSS(993.6,"B",RGLIST,0))
S @$$TRAP^RGZOSF("LERR^RGUTUSR")
X:$D(^RGCDSS(993.6,RGLIST,1)) ^(1)
LERR Q
MGRP(RGMGRP) ;
N RGX
S RGX(0)=""
D MGRP2(RGMGRP)
Q
MGRP2(RGMGRP) ;
N RGZ,RGZ1
Q:RGMGRP=""
S:RGMGRP'=+RGMGRP RGMGRP=+$O(^XMB(3.8,"B",RGMGRP,0))
Q:$D(RGX(RGMGRP))
S RGX(RGMGRP)=""
F RGZ=0:0 S RGZ=+$O(^XMB(3.8,RGMGRP,1,RGZ)) Q:'RGZ S RGOUT(+^(RGZ,0))=""
F RGZ=0:0 S RGZ=+$O(^XMB(3.8,RGMGRP,5,RGZ)) Q:'RGZ D MGRP2(^(RGZ,0))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTUSR 1827 printed Dec 13, 2024@02:37:34 Page 2
RGUTUSR ;CAIRO/DKM - Parse recipient list;04-Sep-1998 11:26;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
+2 ;=================================================================
+3 ; Takes a list of recipients (which may be DUZ #'s, names,
+4 ; mail groups, or special tokens) as input and produces an
+5 ; array of DUZ's as output. If a list element is found in
+6 ; in the token list RGLST, the value of the token entry will
+7 ; be substituted.
+8 ; Inputs:
+9 ; RGUSR = Semicolon-delimited list of recipients
+10 ; RGLST = Special token list
+11 ; Outputs:
+12 ; RGOUT = Local array to receive DUZ list
+13 ;=================================================================
ENTRY(RGUSR,RGOUT,RGLST) ;
+1 NEW RGZ,RGZ1,RGZ2
+2 KILL RGOUT
+3 FOR RGZ=1:1:$LENGTH(RGUSR,";")
SET RGZ1=$PIECE(RGUSR,";",RGZ)
if RGZ1'=""
Begin DoDot:1
+4 if $DATA(RGLST(RGZ1))
SET RGZ1=RGLST(RGZ1)
+5 if RGZ1?.N
QUIT
+6 IF RGZ1?1"-"1.N
DO MGRP(-RGZ1)
SET RGZ1=0
QUIT
+7 SET RGZ2=$EXTRACT(RGZ1,1,2)
+8 IF RGZ2="G."
DO MGRP($EXTRACT(RGZ1,3,999))
QUIT
+9 IF RGZ2="L."
DO LIST($EXTRACT(RGZ1,3,999))
QUIT
+10 SET RGZ1=$$LKP(RGZ1)
End DoDot:1
if RGZ1
SET RGOUT(+RGZ1)=""
+11 QUIT
LKP(RGNAME) ;
+1 NEW RGZ,RGZ1
+2 IF $DATA(^VA(200,"B",RGNAME))
SET RGZ=RGNAME
GOTO L1
+3 SET RGZ=$ORDER(^(RGNAME))
SET RGZ1=$ORDER(^(RGZ))
+4 if (RGZ="")!(RGNAME'=$EXTRACT(RGZ,1,$LENGTH(RGNAME)))
QUIT 0
+5 if (RGZ1'="")&(RGNAME=$EXTRACT(RGZ1,1,$LENGTH(RGNAME)))
QUIT 0
L1 SET RGZ1=$ORDER(^(RGZ,0))
SET RGZ=$ORDER(^(RGZ1))
+1 if 'RGZ1!RGZ
QUIT 0
+2 QUIT RGZ1
LIST(RGLIST) ;
+1 if RGLIST=""
QUIT
+2 if RGLIST'=+RGLIST
SET RGLIST=+$ORDER(^RGCDSS(993.6,"B",RGLIST,0))
+3 SET @$$TRAP^RGZOSF("LERR^RGUTUSR")
+4 if $DATA(^RGCDSS(993.6,RGLIST,1))
XECUTE ^(1)
LERR QUIT
MGRP(RGMGRP) ;
+1 NEW RGX
+2 SET RGX(0)=""
+3 DO MGRP2(RGMGRP)
+4 QUIT
MGRP2(RGMGRP) ;
+1 NEW RGZ,RGZ1
+2 if RGMGRP=""
QUIT
+3 if RGMGRP'=+RGMGRP
SET RGMGRP=+$ORDER(^XMB(3.8,"B",RGMGRP,0))
+4 if $DATA(RGX(RGMGRP))
QUIT
+5 SET RGX(RGMGRP)=""
+6 FOR RGZ=0:0
SET RGZ=+$ORDER(^XMB(3.8,RGMGRP,1,RGZ))
if 'RGZ
QUIT
SET RGOUT(+^(RGZ,0))=""
+7 FOR RGZ=0:0
SET RGZ=+$ORDER(^XMB(3.8,RGMGRP,5,RGZ))
if 'RGZ
QUIT
DO MGRP2(^(RGZ,0))
+8 QUIT
