RGUTUSR.m

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 ---RGUTUSR   1827     printed  Mar 13, 2025@21:42:40                                                                                                                                                                                                     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