249 lines
8.4 KiB
Mathematica
249 lines
8.4 KiB
Mathematica
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
|