FSCRPCLL ;SLC/STAFF-NOIS RPC List Long ;4/4/98 17:56
;;1.1;NOIS;;Sep 06, 1998
;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
N DIR,FILE,FROM,LINE
S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1)),FILE=$P(LINE,U),FROM=$P(LINE,U,2),DIR=$P(LINE,U,3)
I '$L(FILE) Q
S FROM=$$FROM(FROM,FILE)
I $E(FROM,$L(FROM)-1,$L(FROM))="`~" S $E(FROM,$L(FROM)-1,$L(FROM))="@~"
I FILE="LOC" D LOC(FROM,DIR) Q
I FILE="ACLLOC" D ACLLOC(FROM,DIR) Q
I FILE="MOD" D MOD(FROM,DIR) Q
I FILE="ACLMOD" D ACLMOD(FROM,DIR) Q
I FILE="PACK" D PACK(FROM,DIR) Q
I FILE="ACLPACK" D ACLPACK(FROM,DIR) Q
I FILE="MAILGP" D MAILGP(FROM,DIR) Q
I FILE="PATCH" D PATCH(FROM,DIR) Q
I FILE="USER" D USER(FROM,DIR) Q
I FILE="LIST" D LIST(FROM,DIR) Q
I FILE="CALL" D CALL(FROM,DIR) Q
Q
;
LOC(FROM,DIR) ;
N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^FSC("SITE","B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("SITE","B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("SITE",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
Q
;
ACLLOC(FROM,DIR) ;
N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
S FROM=$$UP^XLFSTR(FROM)
F Q:NUM>CNT S FROM=$O(^FSC("SITE","ACL",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("SITE","ACL",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("SITE",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S IEN1=0 F S IEN1=$O(^FSC("SITE","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
...S TEXT=$G(^FSC("SITE",IEN,99,IEN1,0)) Q:'$L(TEXT)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
Q
;
ACLMOD(FROM,DIR) ;
N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
S FROM=$$UP^XLFSTR(FROM)
F Q:NUM>CNT S FROM=$O(^FSC("MOD","ACL",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("MOD","ACL",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S IEN1=0 F S IEN1=$O(^FSC("MOD","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
...S TEXT=$G(^FSC("MOD",IEN,99,IEN1,0)) Q:'$L(TEXT)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
Q
;
MOD(FROM,DIR) ;
N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^FSC("MOD","B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("MOD","B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
Q
;
PACK(FROM,DIR) ;
N IEN,CNT,NUM S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^FSC("PACK","B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("PACK","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PACK",IEN,0))
Q
;
ACLPACK(FROM,DIR) ;
N IEN,IEN1,CNT,NUM,TEXT,ZERO S CNT=44,NUM=0
S FROM=$$UP^XLFSTR(FROM)
F Q:NUM>CNT S FROM=$O(^FSC("MOD","ACL",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("MOD","ACL",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("MOD",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S IEN1=0 F S IEN1=$O(^FSC("MOD","ACL",FROM,IEN,IEN1)) Q:IEN1<1 D
...S TEXT=$G(^FSC("MOD",IEN,99,IEN1,0)) Q:'$L(TEXT)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_TEXT_U_$P(ZERO,U,2,99)
Q
;
MAILGP(FROM,DIR) ;
N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^XMB(3.8,"B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^XMB(3.8,"B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^XMB(3.8,IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)="PR" Q:$O(^XMB(3.8,IEN,4,0))
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
Q
;
PATCH(FROM,DIR) ;
N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^A1AE(11005,"B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^A1AE(11005,"B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^A1AE(11005,IEN,0)) Q:'$L(ZERO)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(ZERO,U)_" Seq# "_$P(ZERO,U,6)_" "_$P(ZERO,U,5)
Q
;
USER(FROM,DIR) ;
N IEN,CNT,NUM,ZERO S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^VA(200,"B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^VA(200,"B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^VA(200,IEN,0)) Q:'$L(ZERO) Q:ZERO I $P(ZERO,U,11),$P(ZERO,U,11)<DT Q
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(ZERO,U)
Q
;
LIST(FROM,DIR) ;
N IEN,CNT,NUM S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^FSC("LIST","B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("LIST","B",FROM,IEN)) Q:'IEN D
..Q:$P($G(^FSC("LIST",IEN,0)),U,99)="INACTIVE" ;*** fix
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("LIST",IEN,0))
Q
;
CALL(FROM,DIR) ;
N IEN,CNT,NUM S CNT=44,NUM=0
F Q:NUM>CNT S FROM=$O(^FSCD("CALL","B",FROM),DIR) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSCD("CALL","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSCD("CALL",IEN,0))
Q
;
FROM(FROM,FILE) ; $$(from) -> exteral value for `ien lookups
N EXACT
I $E(FROM)="`" D Q FROM
.I $E(FROM,$L(FROM)-1)="/" S EXACT=+$E(FROM,2,245)*10
.E S EXACT=1+$E(FROM,2,245)
.I FILE="USER" S FROM=$P($G(^VA(200,EXACT,0)),U)
.I FILE="MOD" S FROM=$P($G(^FSC("MOD",EXACT,0)),U)
.I FILE="ACLMOD" S FROM=$G(^FSC("MOD",EXACT,99,+$O(^FSC("MOD",EXACT,99,0)),0))
.I FILE="LOC" S FROM=$P($G(^FSC("SITE",EXACT,0)),U)
.I FILE="ACLLOC" S FROM=$G(^FSC("SITE",EXACT,99,+$O(^FSC("SITE",EXACT,99,0)),0))
.I FILE="MAILGP" S FROM=$P($G(^XMB(3.8,EXACT,0)),U)
.I FILE="PATCH" S FROM=$P($G(^A1AE(11005,EXACT,0)),U)
.I FILE="PACK" S FROM=$P($G(^FSC("PACK",EXACT,0)),U)
.I FILE="ACLPACK" S FROM=$G(^FSC("PACK",EXACT,99,+$O(^FSC("PACK",EXACT,99,0)),0))
.I FILE="LIST" S FROM=$P($G(^FSC("LIST",EXACT,0)),U)
.S FROM=$E(FROM,1,$L(FROM)-1)_$C($A($E(FROM,$L(FROM)))-1)_"~"
Q FROM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCLL 5587 printed Dec 13, 2024@02:19:32 Page 2
FSCRPCLL ;SLC/STAFF-NOIS RPC List Long ;4/4/98 17:56
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
+1 NEW DIR,FILE,FROM,LINE
+2 SET LINE=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET FILE=$PIECE(LINE,U)
SET FROM=$PIECE(LINE,U,2)
SET DIR=$PIECE(LINE,U,3)
+3 IF '$LENGTH(FILE)
QUIT
+4 SET FROM=$$FROM(FROM,FILE)
+5 IF $EXTRACT(FROM,$LENGTH(FROM)-1,$LENGTH(FROM))="`~"
SET $EXTRACT(FROM,$LENGTH(FROM)-1,$LENGTH(FROM))="@~"
+6 IF FILE="LOC"
DO LOC(FROM,DIR)
QUIT
+7 IF FILE="ACLLOC"
DO ACLLOC(FROM,DIR)
QUIT
+8 IF FILE="MOD"
DO MOD(FROM,DIR)
QUIT
+9 IF FILE="ACLMOD"
DO ACLMOD(FROM,DIR)
QUIT
+10 IF FILE="PACK"
DO PACK(FROM,DIR)
QUIT
+11 IF FILE="ACLPACK"
DO ACLPACK(FROM,DIR)
QUIT
+12 IF FILE="MAILGP"
DO MAILGP(FROM,DIR)
QUIT
+13 IF FILE="PATCH"
DO PATCH(FROM,DIR)
QUIT
+14 IF FILE="USER"
DO USER(FROM,DIR)
QUIT
+15 IF FILE="LIST"
DO LIST(FROM,DIR)
QUIT
+16 IF FILE="CALL"
DO CALL(FROM,DIR)
QUIT
+17 QUIT
+18 ;
LOC(FROM,DIR) ;
+1 NEW IEN,CNT,NUM,ZERO
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("SITE","B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SITE","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^FSC("SITE",IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_ZERO
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
ACLLOC(FROM,DIR) ;
+1 NEW IEN,IEN1,CNT,NUM,TEXT,ZERO
SET CNT=44
SET NUM=0
+2 SET FROM=$$UP^XLFSTR(FROM)
+3 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("SITE","ACL",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SITE","ACL",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+5 SET ZERO=$GET(^FSC("SITE",IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)
QUIT
+6 SET IEN1=0
FOR
SET IEN1=$ORDER(^FSC("SITE","ACL",FROM,IEN,IEN1))
if IEN1<1
QUIT
Begin DoDot:3
+7 SET TEXT=$GET(^FSC("SITE",IEN,99,IEN1,0))
if '$LENGTH(TEXT)
QUIT
End DoDot:3
+8 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_TEXT_U_$PIECE(ZERO,U,2,99)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
ACLMOD(FROM,DIR) ;
+1 NEW IEN,IEN1,CNT,NUM,TEXT,ZERO
SET CNT=44
SET NUM=0
+2 SET FROM=$$UP^XLFSTR(FROM)
+3 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("MOD","ACL",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("MOD","ACL",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+5 SET ZERO=$GET(^FSC("MOD",IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)
QUIT
+6 SET IEN1=0
FOR
SET IEN1=$ORDER(^FSC("MOD","ACL",FROM,IEN,IEN1))
if IEN1<1
QUIT
Begin DoDot:3
+7 SET TEXT=$GET(^FSC("MOD",IEN,99,IEN1,0))
if '$LENGTH(TEXT)
QUIT
End DoDot:3
+8 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_TEXT_U_$PIECE(ZERO,U,2,99)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
MOD(FROM,DIR) ;
+1 NEW IEN,CNT,NUM,ZERO
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("MOD","B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("MOD","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^FSC("MOD",IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_ZERO
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
PACK(FROM,DIR) ;
+1 NEW IEN,CNT,NUM
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("PACK","B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("PACK","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("PACK",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
ACLPACK(FROM,DIR) ;
+1 NEW IEN,IEN1,CNT,NUM,TEXT,ZERO
SET CNT=44
SET NUM=0
+2 SET FROM=$$UP^XLFSTR(FROM)
+3 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("MOD","ACL",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+4 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("MOD","ACL",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+5 SET ZERO=$GET(^FSC("MOD",IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)
QUIT
+6 SET IEN1=0
FOR
SET IEN1=$ORDER(^FSC("MOD","ACL",FROM,IEN,IEN1))
if IEN1<1
QUIT
Begin DoDot:3
+7 SET TEXT=$GET(^FSC("MOD",IEN,99,IEN1,0))
if '$LENGTH(TEXT)
QUIT
End DoDot:3
+8 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_TEXT_U_$PIECE(ZERO,U,2,99)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
MAILGP(FROM,DIR) ;
+1 NEW IEN,CNT,NUM,ZERO
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^XMB(3.8,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^XMB(3.8,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^XMB(3.8,IEN,0))
if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)="PR"
QUIT
if $ORDER(^XMB(3.8,IEN,4,0))
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_ZERO
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
PATCH(FROM,DIR) ;
+1 NEW IEN,CNT,NUM,ZERO
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^A1AE(11005,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^A1AE(11005,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^A1AE(11005,IEN,0))
if '$LENGTH(ZERO)
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$PIECE(ZERO,U)_" Seq# "_$PIECE(ZERO,U,6)_" "_$PIECE(ZERO,U,5)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
USER(FROM,DIR) ;
+1 NEW IEN,CNT,NUM,ZERO
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^VA(200,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^VA(200,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^VA(200,IEN,0))
if '$LENGTH(ZERO)
QUIT
if ZERO
QUIT
IF $PIECE(ZERO,U,11)
IF $PIECE(ZERO,U,11)<DT
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$PIECE(ZERO,U)
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
LIST(FROM,DIR) ;
+1 NEW IEN,CNT,NUM
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSC("LIST","B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("LIST","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 ;*** fix
if $PIECE($GET(^FSC("LIST",IEN,0)),U,99)="INACTIVE"
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("LIST",IEN,0))
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
CALL(FROM,DIR) ;
+1 NEW IEN,CNT,NUM
SET CNT=44
SET NUM=0
+2 FOR
if NUM>CNT
QUIT
SET FROM=$ORDER(^FSCD("CALL","B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSCD("CALL","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSCD("CALL",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
FROM(FROM,FILE) ; $$(from) -> exteral value for `ien lookups
+1 NEW EXACT
+2 IF $EXTRACT(FROM)="`"
Begin DoDot:1
+3 IF $EXTRACT(FROM,$LENGTH(FROM)-1)="/"
SET EXACT=+$EXTRACT(FROM,2,245)*10
+4 IF '$TEST
SET EXACT=1+$EXTRACT(FROM,2,245)
+5 IF FILE="USER"
SET FROM=$PIECE($GET(^VA(200,EXACT,0)),U)
+6 IF FILE="MOD"
SET FROM=$PIECE($GET(^FSC("MOD",EXACT,0)),U)
+7 IF FILE="ACLMOD"
SET FROM=$GET(^FSC("MOD",EXACT,99,+$ORDER(^FSC("MOD",EXACT,99,0)),0))
+8 IF FILE="LOC"
SET FROM=$PIECE($GET(^FSC("SITE",EXACT,0)),U)
+9 IF FILE="ACLLOC"
SET FROM=$GET(^FSC("SITE",EXACT,99,+$ORDER(^FSC("SITE",EXACT,99,0)),0))
+10 IF FILE="MAILGP"
SET FROM=$PIECE($GET(^XMB(3.8,EXACT,0)),U)
+11 IF FILE="PATCH"
SET FROM=$PIECE($GET(^A1AE(11005,EXACT,0)),U)
+12 IF FILE="PACK"
SET FROM=$PIECE($GET(^FSC("PACK",EXACT,0)),U)
+13 IF FILE="ACLPACK"
SET FROM=$GET(^FSC("PACK",EXACT,99,+$ORDER(^FSC("PACK",EXACT,99,0)),0))
+14 IF FILE="LIST"
SET FROM=$PIECE($GET(^FSC("LIST",EXACT,0)),U)
+15 SET FROM=$EXTRACT(FROM,1,$LENGTH(FROM)-1)_$CHAR($ASCII($EXTRACT(FROM,$LENGTH(FROM)))-1)_"~"
End DoDot:1
QUIT FROM
+16 QUIT FROM
