FSCRPCLS ;SLC/STAFF-NOIS RPC List Short ;7/23/98 14:17
;;1.1;NOIS;;Sep 06, 1998
;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
N DIR,FILE,FROM,LINE,NUM
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
I FILE="STATUS" D STATUS Q
I FILE="SSTATUS" D SSTATUS Q
I FILE="RSTATUS" D RSTATUS Q
I FILE="SPEC" D SPEC Q
I FILE="PRI" D PRI Q
I $E(FILE,1,3)="SUB" D Q
.I $P(FILE,";",2) D SUBPACK(+$P(FILE,";",2)) Q
.D SUB Q
I FILE="ISC" D ISC Q
I FILE="FUNC" D FUNC Q
I FILE="TASK" D TASK Q
I FILE="LTYPE" D LTYPE Q
I FILE="PACKGP" D PACKGP Q
I FILE="VISN" D VISN Q
I FILE="EPTYPE" D EPTYPE Q
I FILE="SYSTEM" D SYSTEM Q
I FILE="FIELD" D FIELD Q
I FILE="FORMAT_SORT" D SORT Q
I FILE="FORMAT_DISPLAY" D DISPLAY Q
I FILE="USER_AFFIL" D UPACK Q
I FILE="USER_FORMAT_SORT" D USORT Q
I FILE="USER_FORMAT_DISPLAY" D UDISPLAY Q
I FILE="COMMON_LISTS" D CLISTS Q
I $P(FILE,";")="USER_LISTS" D ULISTS Q
I $E(FILE,1,3)="WEB" D WEB(+$P(FILE,";",2)) Q
Q
;
SSTATUS ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
..I $P($G(^FSC("STATUS",IEN,0)),U,2)="D" Q
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
Q
;
RSTATUS ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
..I $P($G(^FSC("STATUS",IEN,0)),U,2)="S" Q
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
Q
;
STATUS ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
Q
;
SPEC ;
K ^TMP("FSC SPEC",$J)
N FROM,IEN,NUM,ZERO S NUM=0
S IEN=0 F S IEN=$O(^FSC("SPEC",IEN)) Q:IEN<1 S ZERO=$G(^(IEN,0)) I $L(ZERO),'$P(ZERO,U,2) D
.S NAME=$P($G(^VA(200,IEN,0)),U) I $P($G(^(0)),U,11),$P($G(^(0)),U,11)<DT Q
.I $L(NAME) S ^TMP("FSC SPEC",$J,NAME,IEN)=NAME_U_$P(ZERO,U,2,99)
S FROM="" F S FROM=$O(^TMP("FSC SPEC",$J,FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^TMP("FSC SPEC",$J,FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_^TMP("FSC SPEC",$J,FROM,IEN)
K ^TMP("FSC SPEC",$J)
Q
;
PRI ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("PRI","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("PRI","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PRI",IEN,0))
Q
;
SUB ;
N FROM,IEN,NUM,PACK,PACKNAME S NUM=0
S FROM="" F S FROM=$O(^FSC("SUB","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("SUB","B",FROM,IEN)) Q:'IEN D
..S PACK=+$P($G(^FSC("SUB",IEN,0)),U,2)
..I 'PACK Q
..S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(^FSC("SUB",IEN,0),U)_" - "_PACKNAME_U_$P(^(0),U)
Q
;
SUBPACK(PACK) ;
N FROM,IEN,LINE,NAME,NUM,PACKNAME K ^TMP("FSC TEMP",$J)
S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
S IEN=0 F S IEN=$O(^FSC("SUB","AC",PACK,IEN)) Q:IEN="" D
.S NAME=$P($G(^FSC("SUB",IEN,0)),U)
.I '$L(NAME) Q
.S ^TMP("FSC TEMP",$J,NAME,IEN)=IEN_U_NAME_" - "_PACKNAME_U_NAME
S NUM=0
S NAME="" F S NAME=$O(^TMP("FSC TEMP",$J,NAME)) Q:NAME="" D
.S IEN=0 F S IEN=$O(^TMP("FSC TEMP",$J,NAME,IEN)) Q:IEN<1 S LINE=^(IEN) D
..S NUM=NUM+1
..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
K ^TMP("FSC TEMP",$J)
Q
;
ISC ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("ISC","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("ISC","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("ISC",IEN,0))
Q
;
FUNC ;
N FROM,IEN,NUM,ZERO S NUM=0
S FROM="" F S FROM=$O(^FSC("FUNC","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("FUNC","B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("FUNC",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
Q
;
TASK ;
N FROM,IEN,NUM,ZERO S NUM=0
S FROM="" F S FROM=$O(^FSC("TASK","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("TASK","B",FROM,IEN)) Q:'IEN D
..S ZERO=$G(^FSC("TASK",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
Q
;
LTYPE ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("LTYPE","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("LTYPE","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("LTYPE",IEN,0))
Q
;
PACKGP ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("PACKG","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("PACKG","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PACKG",IEN,0))
Q
;
VISN ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("VISN","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("VISN","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("VISN",IEN,0))
Q
;
WEB(PACK) ;
N IEN,NUM S NUM=0
S IEN=0 F S IEN=$O(^FSCD("WEB","C",PACK,IEN)) Q:'IEN D
.S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSCD("WEB",IEN,1))
Q
EPTYPE ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("EPTYPE","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("EPTYPE","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("EPTYPE",IEN,0))
Q
;
SYSTEM ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("SYSTEM","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("SYSTEM","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("SYSTEM",IEN,0))
Q
;
FIELD ;
N FROM,IEN,NUM S NUM=0
S FROM="" F S FROM=$O(^FSC("FLD","B",FROM)) Q:FROM="" D
.S IEN=0 F S IEN=$O(^FSC("FLD","B",FROM,IEN)) Q:'IEN D
..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("FLD",IEN,0))
Q
;
UPACK ;
N CNT,LINE,NUM,PACK
S (CNT,NUM)=0 F S NUM=$O(^FSC("SPEC",DUZ,30,NUM)) Q:NUM<1 S PACK=+$G(^(NUM,0)) I PACK D
.S LINE=$G(^FSC("PACK",PACK,0))
.I '$L(LINE) Q
.S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=PACK_U_LINE
Q
;
USORT ;
N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
S NUM=0 F S NUM=$O(^FSC("FORMAT","C",DUZ,NUM)) Q:NUM<1 S LINE=$G(^FSC("FORMAT",NUM,0)) I $P(LINE,U,2)="S" D
.S FIELD="",DESCEND=""
.S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
..I +LINE1<1 Q
..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
Q
;
UDISPLAY ;
N FIELD,LINE,LINE1,NUM,SUBNUM
S NUM=0 F S NUM=$O(^FSC("FORMAT","C",DUZ,NUM)) Q:NUM<1 S LINE=$G(^FSC("FORMAT",NUM,0)) I $P(LINE,U,2)="F" D
.S FIELD=""
.S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
..I +LINE1<1 Q
..S FIELD=FIELD_$P(LINE1,U)_";"
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
Q
;
SORT ;
N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
S NUM=0 F S NUM=$O(^FSC("FORMAT",NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) I $P(LINE,U,2)="S" D
.S FIELD="",DESCEND=""
.S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
..I +LINE1<1 Q
..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
Q
;
DISPLAY ;
N FIELD,LINE,LINE1,NUM,SUBNUM
S NUM=0 F S NUM=$O(^FSC("FORMAT",NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)) I $P(LINE,U,2)="F" D
.S FIELD=""
.S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
..I +LINE1<1 Q
..S FIELD=FIELD_$P(LINE1,U)_";"
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
Q
;
CLISTS ;
N CNT,LIST,LISTNAME,NUM,ZERO
S CNT=0
S LISTNAME="" F S LISTNAME=$O(^FSC("LIST","B",LISTNAME)) Q:LISTNAME="" D
.S NUM=0 F S NUM=$O(^FSC("LIST","B",LISTNAME,NUM)) Q:NUM<1 D
..S ZERO=$G(^FSC("LIST",NUM,0))
..I $L(ZERO),'$P(ZERO,U,2) D
...S CNT=CNT+1
...S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=NUM_U_ZERO
Q
;
ULISTS ;
N CNT,LINE,LIST,LISTNAME,NUM,USER,ZERO K ^TMP("FSC MERGE",$J)
S USER=+$P(FILE,";",2)
I '$D(^VA(200,USER,0)) Q
S CNT=0
S NUM=0 F S NUM=$O(^FSC("LIST","C",USER,NUM)) Q:NUM<1 D
.S ZERO=$G(^FSC("LIST",NUM,0))
.Q:'$L(ZERO) Q:$P(ZERO,U,2)'=USER
.S ^TMP("FSC MERGE",$J,$P(ZERO,U),NUM)=NUM_U_ZERO
S CNT=0
S LISTNAME="" F S LISTNAME=$O(^TMP("FSC MERGE",$J,LISTNAME)) Q:LISTNAME="" D
.S NUM=0 F S NUM=$O(^TMP("FSC MERGE",$J,LISTNAME,NUM)) Q:NUM<1 S LINE=^(NUM) D
..S CNT=CNT+1
..S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
K ^TMP("FSC MERGE",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCLS 8857 printed Oct 16, 2024@18:20:11 Page 2
FSCRPCLS ;SLC/STAFF-NOIS RPC List Short ;7/23/98 14:17
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
+1 NEW DIR,FILE,FROM,LINE,NUM
+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 IF FILE="STATUS"
DO STATUS
QUIT
+5 IF FILE="SSTATUS"
DO SSTATUS
QUIT
+6 IF FILE="RSTATUS"
DO RSTATUS
QUIT
+7 IF FILE="SPEC"
DO SPEC
QUIT
+8 IF FILE="PRI"
DO PRI
QUIT
+9 IF $EXTRACT(FILE,1,3)="SUB"
Begin DoDot:1
+10 IF $PIECE(FILE,";",2)
DO SUBPACK(+$PIECE(FILE,";",2))
QUIT
+11 DO SUB
QUIT
End DoDot:1
QUIT
+12 IF FILE="ISC"
DO ISC
QUIT
+13 IF FILE="FUNC"
DO FUNC
QUIT
+14 IF FILE="TASK"
DO TASK
QUIT
+15 IF FILE="LTYPE"
DO LTYPE
QUIT
+16 IF FILE="PACKGP"
DO PACKGP
QUIT
+17 IF FILE="VISN"
DO VISN
QUIT
+18 IF FILE="EPTYPE"
DO EPTYPE
QUIT
+19 IF FILE="SYSTEM"
DO SYSTEM
QUIT
+20 IF FILE="FIELD"
DO FIELD
QUIT
+21 IF FILE="FORMAT_SORT"
DO SORT
QUIT
+22 IF FILE="FORMAT_DISPLAY"
DO DISPLAY
QUIT
+23 IF FILE="USER_AFFIL"
DO UPACK
QUIT
+24 IF FILE="USER_FORMAT_SORT"
DO USORT
QUIT
+25 IF FILE="USER_FORMAT_DISPLAY"
DO UDISPLAY
QUIT
+26 IF FILE="COMMON_LISTS"
DO CLISTS
QUIT
+27 IF $PIECE(FILE,";")="USER_LISTS"
DO ULISTS
QUIT
+28 IF $EXTRACT(FILE,1,3)="WEB"
DO WEB(+$PIECE(FILE,";",2))
QUIT
+29 QUIT
+30 ;
SSTATUS ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("STATUS","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("STATUS","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 IF $PIECE($GET(^FSC("STATUS",IEN,0)),U,2)="D"
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("STATUS",IEN,0))
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
RSTATUS ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("STATUS","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("STATUS","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 IF $PIECE($GET(^FSC("STATUS",IEN,0)),U,2)="S"
QUIT
+5 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("STATUS",IEN,0))
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
STATUS ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("STATUS","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("STATUS","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("STATUS",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
SPEC ;
+1 KILL ^TMP("FSC SPEC",$JOB)
+2 NEW FROM,IEN,NUM,ZERO
SET NUM=0
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SPEC",IEN))
if IEN<1
QUIT
SET ZERO=$GET(^(IEN,0))
IF $LENGTH(ZERO)
IF '$PIECE(ZERO,U,2)
Begin DoDot:1
+4 SET NAME=$PIECE($GET(^VA(200,IEN,0)),U)
IF $PIECE($GET(^(0)),U,11)
IF $PIECE($GET(^(0)),U,11)<DT
QUIT
+5 IF $LENGTH(NAME)
SET ^TMP("FSC SPEC",$JOB,NAME,IEN)=NAME_U_$PIECE(ZERO,U,2,99)
End DoDot:1
+6 SET FROM=""
FOR
SET FROM=$ORDER(^TMP("FSC SPEC",$JOB,FROM))
if FROM=""
QUIT
Begin DoDot:1
+7 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("FSC SPEC",$JOB,FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+8 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_^TMP("FSC SPEC",$JOB,FROM,IEN)
End DoDot:2
End DoDot:1
+9 KILL ^TMP("FSC SPEC",$JOB)
+10 QUIT
+11 ;
PRI ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("PRI","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("PRI","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("PRI",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
SUB ;
+1 NEW FROM,IEN,NUM,PACK,PACKNAME
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("SUB","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SUB","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET PACK=+$PIECE($GET(^FSC("SUB",IEN,0)),U,2)
+5 IF 'PACK
QUIT
+6 SET PACKNAME=$PIECE($GET(^FSC("PACK",PACK,0)),U)
+7 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$PIECE(^FSC("SUB",IEN,0),U)_" - "_PACKNAME_U_$PIECE(^(0),U)
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SUBPACK(PACK) ;
+1 NEW FROM,IEN,LINE,NAME,NUM,PACKNAME
KILL ^TMP("FSC TEMP",$JOB)
+2 SET PACKNAME=$PIECE($GET(^FSC("PACK",PACK,0)),U)
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SUB","AC",PACK,IEN))
if IEN=""
QUIT
Begin DoDot:1
+4 SET NAME=$PIECE($GET(^FSC("SUB",IEN,0)),U)
+5 IF '$LENGTH(NAME)
QUIT
+6 SET ^TMP("FSC TEMP",$JOB,NAME,IEN)=IEN_U_NAME_" - "_PACKNAME_U_NAME
End DoDot:1
+7 SET NUM=0
+8 SET NAME=""
FOR
SET NAME=$ORDER(^TMP("FSC TEMP",$JOB,NAME))
if NAME=""
QUIT
Begin DoDot:1
+9 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("FSC TEMP",$JOB,NAME,IEN))
if IEN<1
QUIT
SET LINE=^(IEN)
Begin DoDot:2
+10 SET NUM=NUM+1
+11 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=LINE
End DoDot:2
End DoDot:1
+12 KILL ^TMP("FSC TEMP",$JOB)
+13 QUIT
+14 ;
ISC ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("ISC","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("ISC","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("ISC",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
FUNC ;
+1 NEW FROM,IEN,NUM,ZERO
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("FUNC","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("FUNC","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^FSC("FUNC",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 ;
TASK ;
+1 NEW FROM,IEN,NUM,ZERO
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("TASK","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("TASK","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET ZERO=$GET(^FSC("TASK",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 ;
LTYPE ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("LTYPE","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("LTYPE","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("LTYPE",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
PACKGP ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("PACKG","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("PACKG","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("PACKG",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
VISN ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("VISN","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("VISN","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("VISN",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
WEB(PACK) ;
+1 NEW IEN,NUM
SET NUM=0
+2 SET IEN=0
FOR
SET IEN=$ORDER(^FSCD("WEB","C",PACK,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSCD("WEB",IEN,1))
End DoDot:1
+4 QUIT
EPTYPE ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("EPTYPE","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("EPTYPE","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("EPTYPE",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
SYSTEM ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("SYSTEM","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("SYSTEM","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("SYSTEM",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
FIELD ;
+1 NEW FROM,IEN,NUM
SET NUM=0
+2 SET FROM=""
FOR
SET FROM=$ORDER(^FSC("FLD","B",FROM))
if FROM=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^FSC("FLD","B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 SET NUM=NUM+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=IEN_U_$GET(^FSC("FLD",IEN,0))
End DoDot:2
End DoDot:1
+5 QUIT
+6 ;
UPACK ;
+1 NEW CNT,LINE,NUM,PACK
+2 SET (CNT,NUM)=0
FOR
SET NUM=$ORDER(^FSC("SPEC",DUZ,30,NUM))
if NUM<1
QUIT
SET PACK=+$GET(^(NUM,0))
IF PACK
Begin DoDot:1
+3 SET LINE=$GET(^FSC("PACK",PACK,0))
+4 IF '$LENGTH(LINE)
QUIT
+5 SET CNT=CNT+1
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=PACK_U_LINE
End DoDot:1
+6 QUIT
+7 ;
USORT ;
+1 NEW DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("FORMAT","C",DUZ,NUM))
if NUM<1
QUIT
SET LINE=$GET(^FSC("FORMAT",NUM,0))
IF $PIECE(LINE,U,2)="S"
Begin DoDot:1
+3 SET FIELD=""
SET DESCEND=""
+4 SET SUBNUM=0
FOR
SET SUBNUM=$ORDER(^FSC("FORMAT",NUM,2,SUBNUM))
if SUBNUM<1
QUIT
SET LINE1=$GET(^(SUBNUM,0))
Begin DoDot:2
+5 IF +LINE1<1
QUIT
+6 SET DESCEND=$PIECE(LINE1,U,8)
IF 'DESCEND
SET DESCEND=0
+7 SET FIELD=FIELD_$PIECE(LINE1,U)_":"_DESCEND_";"
End DoDot:2
+8 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_LINE
SET $PIECE(^(NUM),U,7)=FIELD
End DoDot:1
+9 QUIT
+10 ;
UDISPLAY ;
+1 NEW FIELD,LINE,LINE1,NUM,SUBNUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("FORMAT","C",DUZ,NUM))
if NUM<1
QUIT
SET LINE=$GET(^FSC("FORMAT",NUM,0))
IF $PIECE(LINE,U,2)="F"
Begin DoDot:1
+3 SET FIELD=""
+4 SET SUBNUM=0
FOR
SET SUBNUM=$ORDER(^FSC("FORMAT",NUM,2,SUBNUM))
if SUBNUM<1
QUIT
SET LINE1=$GET(^(SUBNUM,0))
Begin DoDot:2
+5 IF +LINE1<1
QUIT
+6 SET FIELD=FIELD_$PIECE(LINE1,U)_";"
End DoDot:2
+7 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_LINE
SET $PIECE(^(NUM),U,7)=FIELD
End DoDot:1
+8 QUIT
+9 ;
SORT ;
+1 NEW DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("FORMAT",NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
IF $PIECE(LINE,U,2)="S"
Begin DoDot:1
+3 SET FIELD=""
SET DESCEND=""
+4 SET SUBNUM=0
FOR
SET SUBNUM=$ORDER(^FSC("FORMAT",NUM,2,SUBNUM))
if SUBNUM<1
QUIT
SET LINE1=$GET(^(SUBNUM,0))
Begin DoDot:2
+5 IF +LINE1<1
QUIT
+6 SET DESCEND=$PIECE(LINE1,U,8)
IF 'DESCEND
SET DESCEND=0
+7 SET FIELD=FIELD_$PIECE(LINE1,U)_":"_DESCEND_";"
End DoDot:2
+8 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_LINE
SET $PIECE(^(NUM),U,7)=FIELD
End DoDot:1
+9 QUIT
+10 ;
DISPLAY ;
+1 NEW FIELD,LINE,LINE1,NUM,SUBNUM
+2 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("FORMAT",NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
IF $PIECE(LINE,U,2)="F"
Begin DoDot:1
+3 SET FIELD=""
+4 SET SUBNUM=0
FOR
SET SUBNUM=$ORDER(^FSC("FORMAT",NUM,2,SUBNUM))
if SUBNUM<1
QUIT
SET LINE1=$GET(^(SUBNUM,0))
Begin DoDot:2
+5 IF +LINE1<1
QUIT
+6 SET FIELD=FIELD_$PIECE(LINE1,U)_";"
End DoDot:2
+7 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_LINE
SET $PIECE(^(NUM),U,7)=FIELD
End DoDot:1
+8 QUIT
+9 ;
CLISTS ;
+1 NEW CNT,LIST,LISTNAME,NUM,ZERO
+2 SET CNT=0
+3 SET LISTNAME=""
FOR
SET LISTNAME=$ORDER(^FSC("LIST","B",LISTNAME))
if LISTNAME=""
QUIT
Begin DoDot:1
+4 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("LIST","B",LISTNAME,NUM))
if NUM<1
QUIT
Begin DoDot:2
+5 SET ZERO=$GET(^FSC("LIST",NUM,0))
+6 IF $LENGTH(ZERO)
IF '$PIECE(ZERO,U,2)
Begin DoDot:3
+7 SET CNT=CNT+1
+8 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=NUM_U_ZERO
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
ULISTS ;
+1 NEW CNT,LINE,LIST,LISTNAME,NUM,USER,ZERO
KILL ^TMP("FSC MERGE",$JOB)
+2 SET USER=+$PIECE(FILE,";",2)
+3 IF '$DATA(^VA(200,USER,0))
QUIT
+4 SET CNT=0
+5 SET NUM=0
FOR
SET NUM=$ORDER(^FSC("LIST","C",USER,NUM))
if NUM<1
QUIT
Begin DoDot:1
+6 SET ZERO=$GET(^FSC("LIST",NUM,0))
+7 if '$LENGTH(ZERO)
QUIT
if $PIECE(ZERO,U,2)'=USER
QUIT
+8 SET ^TMP("FSC MERGE",$JOB,$PIECE(ZERO,U),NUM)=NUM_U_ZERO
End DoDot:1
+9 SET CNT=0
+10 SET LISTNAME=""
FOR
SET LISTNAME=$ORDER(^TMP("FSC MERGE",$JOB,LISTNAME))
if LISTNAME=""
QUIT
Begin DoDot:1
+11 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSC MERGE",$JOB,LISTNAME,NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:2
+12 SET CNT=CNT+1
+13 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:2
End DoDot:1
+14 KILL ^TMP("FSC MERGE",$JOB)
+15 QUIT
