| 1 | FSCRPCLS ;SLC/STAFF-NOIS RPC List Short ;7/23/98 14:17
|
|---|
| 2 | ;;1.1;NOIS;;Sep 06, 1998
|
|---|
| 3 | ;
|
|---|
| 4 | FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
|
|---|
| 5 | N DIR,FILE,FROM,LINE,NUM
|
|---|
| 6 | S LINE=$G(^TMP("FSCRPC",$J,"INPUT",1)),FILE=$P(LINE,U),FROM=$P(LINE,U,2),DIR=$P(LINE,U,3)
|
|---|
| 7 | I '$L(FILE) Q
|
|---|
| 8 | I FILE="STATUS" D STATUS Q
|
|---|
| 9 | I FILE="SSTATUS" D SSTATUS Q
|
|---|
| 10 | I FILE="RSTATUS" D RSTATUS Q
|
|---|
| 11 | I FILE="SPEC" D SPEC Q
|
|---|
| 12 | I FILE="PRI" D PRI Q
|
|---|
| 13 | I $E(FILE,1,3)="SUB" D Q
|
|---|
| 14 | .I $P(FILE,";",2) D SUBPACK(+$P(FILE,";",2)) Q
|
|---|
| 15 | .D SUB Q
|
|---|
| 16 | I FILE="ISC" D ISC Q
|
|---|
| 17 | I FILE="FUNC" D FUNC Q
|
|---|
| 18 | I FILE="TASK" D TASK Q
|
|---|
| 19 | I FILE="LTYPE" D LTYPE Q
|
|---|
| 20 | I FILE="PACKGP" D PACKGP Q
|
|---|
| 21 | I FILE="VISN" D VISN Q
|
|---|
| 22 | I FILE="EPTYPE" D EPTYPE Q
|
|---|
| 23 | I FILE="SYSTEM" D SYSTEM Q
|
|---|
| 24 | I FILE="FIELD" D FIELD Q
|
|---|
| 25 | I FILE="FORMAT_SORT" D SORT Q
|
|---|
| 26 | I FILE="FORMAT_DISPLAY" D DISPLAY Q
|
|---|
| 27 | I FILE="USER_AFFIL" D UPACK Q
|
|---|
| 28 | I FILE="USER_FORMAT_SORT" D USORT Q
|
|---|
| 29 | I FILE="USER_FORMAT_DISPLAY" D UDISPLAY Q
|
|---|
| 30 | I FILE="COMMON_LISTS" D CLISTS Q
|
|---|
| 31 | I $P(FILE,";")="USER_LISTS" D ULISTS Q
|
|---|
| 32 | I $E(FILE,1,3)="WEB" D WEB(+$P(FILE,";",2)) Q
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | SSTATUS ;
|
|---|
| 36 | N FROM,IEN,NUM S NUM=0
|
|---|
| 37 | S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
|
|---|
| 38 | .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
|
|---|
| 39 | ..I $P($G(^FSC("STATUS",IEN,0)),U,2)="D" Q
|
|---|
| 40 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | RSTATUS ;
|
|---|
| 44 | N FROM,IEN,NUM S NUM=0
|
|---|
| 45 | S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
|
|---|
| 46 | .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
|
|---|
| 47 | ..I $P($G(^FSC("STATUS",IEN,0)),U,2)="S" Q
|
|---|
| 48 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | STATUS ;
|
|---|
| 52 | N FROM,IEN,NUM S NUM=0
|
|---|
| 53 | S FROM="" F S FROM=$O(^FSC("STATUS","B",FROM)) Q:FROM="" D
|
|---|
| 54 | .S IEN=0 F S IEN=$O(^FSC("STATUS","B",FROM,IEN)) Q:'IEN D
|
|---|
| 55 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("STATUS",IEN,0))
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | SPEC ;
|
|---|
| 59 | K ^TMP("FSC SPEC",$J)
|
|---|
| 60 | N FROM,IEN,NUM,ZERO S NUM=0
|
|---|
| 61 | 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
|
|---|
| 62 | .S NAME=$P($G(^VA(200,IEN,0)),U) I $P($G(^(0)),U,11),$P($G(^(0)),U,11)<DT Q
|
|---|
| 63 | .I $L(NAME) S ^TMP("FSC SPEC",$J,NAME,IEN)=NAME_U_$P(ZERO,U,2,99)
|
|---|
| 64 | S FROM="" F S FROM=$O(^TMP("FSC SPEC",$J,FROM)) Q:FROM="" D
|
|---|
| 65 | .S IEN=0 F S IEN=$O(^TMP("FSC SPEC",$J,FROM,IEN)) Q:'IEN D
|
|---|
| 66 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_^TMP("FSC SPEC",$J,FROM,IEN)
|
|---|
| 67 | K ^TMP("FSC SPEC",$J)
|
|---|
| 68 | Q
|
|---|
| 69 | ;
|
|---|
| 70 | PRI ;
|
|---|
| 71 | N FROM,IEN,NUM S NUM=0
|
|---|
| 72 | S FROM="" F S FROM=$O(^FSC("PRI","B",FROM)) Q:FROM="" D
|
|---|
| 73 | .S IEN=0 F S IEN=$O(^FSC("PRI","B",FROM,IEN)) Q:'IEN D
|
|---|
| 74 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PRI",IEN,0))
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | SUB ;
|
|---|
| 78 | N FROM,IEN,NUM,PACK,PACKNAME S NUM=0
|
|---|
| 79 | S FROM="" F S FROM=$O(^FSC("SUB","B",FROM)) Q:FROM="" D
|
|---|
| 80 | .S IEN=0 F S IEN=$O(^FSC("SUB","B",FROM,IEN)) Q:'IEN D
|
|---|
| 81 | ..S PACK=+$P($G(^FSC("SUB",IEN,0)),U,2)
|
|---|
| 82 | ..I 'PACK Q
|
|---|
| 83 | ..S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
|
|---|
| 84 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$P(^FSC("SUB",IEN,0),U)_" - "_PACKNAME_U_$P(^(0),U)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | SUBPACK(PACK) ;
|
|---|
| 88 | N FROM,IEN,LINE,NAME,NUM,PACKNAME K ^TMP("FSC TEMP",$J)
|
|---|
| 89 | S PACKNAME=$P($G(^FSC("PACK",PACK,0)),U)
|
|---|
| 90 | S IEN=0 F S IEN=$O(^FSC("SUB","AC",PACK,IEN)) Q:IEN="" D
|
|---|
| 91 | .S NAME=$P($G(^FSC("SUB",IEN,0)),U)
|
|---|
| 92 | .I '$L(NAME) Q
|
|---|
| 93 | .S ^TMP("FSC TEMP",$J,NAME,IEN)=IEN_U_NAME_" - "_PACKNAME_U_NAME
|
|---|
| 94 | S NUM=0
|
|---|
| 95 | S NAME="" F S NAME=$O(^TMP("FSC TEMP",$J,NAME)) Q:NAME="" D
|
|---|
| 96 | .S IEN=0 F S IEN=$O(^TMP("FSC TEMP",$J,NAME,IEN)) Q:IEN<1 S LINE=^(IEN) D
|
|---|
| 97 | ..S NUM=NUM+1
|
|---|
| 98 | ..S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=LINE
|
|---|
| 99 | K ^TMP("FSC TEMP",$J)
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | ISC ;
|
|---|
| 103 | N FROM,IEN,NUM S NUM=0
|
|---|
| 104 | S FROM="" F S FROM=$O(^FSC("ISC","B",FROM)) Q:FROM="" D
|
|---|
| 105 | .S IEN=0 F S IEN=$O(^FSC("ISC","B",FROM,IEN)) Q:'IEN D
|
|---|
| 106 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("ISC",IEN,0))
|
|---|
| 107 | Q
|
|---|
| 108 | ;
|
|---|
| 109 | FUNC ;
|
|---|
| 110 | N FROM,IEN,NUM,ZERO S NUM=0
|
|---|
| 111 | S FROM="" F S FROM=$O(^FSC("FUNC","B",FROM)) Q:FROM="" D
|
|---|
| 112 | .S IEN=0 F S IEN=$O(^FSC("FUNC","B",FROM,IEN)) Q:'IEN D
|
|---|
| 113 | ..S ZERO=$G(^FSC("FUNC",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
|
|---|
| 114 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | TASK ;
|
|---|
| 118 | N FROM,IEN,NUM,ZERO S NUM=0
|
|---|
| 119 | S FROM="" F S FROM=$O(^FSC("TASK","B",FROM)) Q:FROM="" D
|
|---|
| 120 | .S IEN=0 F S IEN=$O(^FSC("TASK","B",FROM,IEN)) Q:'IEN D
|
|---|
| 121 | ..S ZERO=$G(^FSC("TASK",IEN,0)) Q:'$L(ZERO) Q:$P(ZERO,U,2)
|
|---|
| 122 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_ZERO
|
|---|
| 123 | Q
|
|---|
| 124 | ;
|
|---|
| 125 | LTYPE ;
|
|---|
| 126 | N FROM,IEN,NUM S NUM=0
|
|---|
| 127 | S FROM="" F S FROM=$O(^FSC("LTYPE","B",FROM)) Q:FROM="" D
|
|---|
| 128 | .S IEN=0 F S IEN=$O(^FSC("LTYPE","B",FROM,IEN)) Q:'IEN D
|
|---|
| 129 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("LTYPE",IEN,0))
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | PACKGP ;
|
|---|
| 133 | N FROM,IEN,NUM S NUM=0
|
|---|
| 134 | S FROM="" F S FROM=$O(^FSC("PACKG","B",FROM)) Q:FROM="" D
|
|---|
| 135 | .S IEN=0 F S IEN=$O(^FSC("PACKG","B",FROM,IEN)) Q:'IEN D
|
|---|
| 136 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("PACKG",IEN,0))
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | VISN ;
|
|---|
| 140 | N FROM,IEN,NUM S NUM=0
|
|---|
| 141 | S FROM="" F S FROM=$O(^FSC("VISN","B",FROM)) Q:FROM="" D
|
|---|
| 142 | .S IEN=0 F S IEN=$O(^FSC("VISN","B",FROM,IEN)) Q:'IEN D
|
|---|
| 143 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("VISN",IEN,0))
|
|---|
| 144 | Q
|
|---|
| 145 | ;
|
|---|
| 146 | WEB(PACK) ;
|
|---|
| 147 | N IEN,NUM S NUM=0
|
|---|
| 148 | S IEN=0 F S IEN=$O(^FSCD("WEB","C",PACK,IEN)) Q:'IEN D
|
|---|
| 149 | .S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSCD("WEB",IEN,1))
|
|---|
| 150 | Q
|
|---|
| 151 | EPTYPE ;
|
|---|
| 152 | N FROM,IEN,NUM S NUM=0
|
|---|
| 153 | S FROM="" F S FROM=$O(^FSC("EPTYPE","B",FROM)) Q:FROM="" D
|
|---|
| 154 | .S IEN=0 F S IEN=$O(^FSC("EPTYPE","B",FROM,IEN)) Q:'IEN D
|
|---|
| 155 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("EPTYPE",IEN,0))
|
|---|
| 156 | Q
|
|---|
| 157 | ;
|
|---|
| 158 | SYSTEM ;
|
|---|
| 159 | N FROM,IEN,NUM S NUM=0
|
|---|
| 160 | S FROM="" F S FROM=$O(^FSC("SYSTEM","B",FROM)) Q:FROM="" D
|
|---|
| 161 | .S IEN=0 F S IEN=$O(^FSC("SYSTEM","B",FROM,IEN)) Q:'IEN D
|
|---|
| 162 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("SYSTEM",IEN,0))
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | FIELD ;
|
|---|
| 166 | N FROM,IEN,NUM S NUM=0
|
|---|
| 167 | S FROM="" F S FROM=$O(^FSC("FLD","B",FROM)) Q:FROM="" D
|
|---|
| 168 | .S IEN=0 F S IEN=$O(^FSC("FLD","B",FROM,IEN)) Q:'IEN D
|
|---|
| 169 | ..S NUM=NUM+1,^TMP("FSCRPC",$J,"OUTPUT",NUM)=IEN_U_$G(^FSC("FLD",IEN,0))
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
| 172 | UPACK ;
|
|---|
| 173 | N CNT,LINE,NUM,PACK
|
|---|
| 174 | S (CNT,NUM)=0 F S NUM=$O(^FSC("SPEC",DUZ,30,NUM)) Q:NUM<1 S PACK=+$G(^(NUM,0)) I PACK D
|
|---|
| 175 | .S LINE=$G(^FSC("PACK",PACK,0))
|
|---|
| 176 | .I '$L(LINE) Q
|
|---|
| 177 | .S CNT=CNT+1,^TMP("FSCRPC",$J,"OUTPUT",CNT)=PACK_U_LINE
|
|---|
| 178 | Q
|
|---|
| 179 | ;
|
|---|
| 180 | USORT ;
|
|---|
| 181 | N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
|
|---|
| 182 | 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
|
|---|
| 183 | .S FIELD="",DESCEND=""
|
|---|
| 184 | .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
|
|---|
| 185 | ..I +LINE1<1 Q
|
|---|
| 186 | ..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
|
|---|
| 187 | ..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
|
|---|
| 188 | .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
|
|---|
| 189 | Q
|
|---|
| 190 | ;
|
|---|
| 191 | UDISPLAY ;
|
|---|
| 192 | N FIELD,LINE,LINE1,NUM,SUBNUM
|
|---|
| 193 | 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
|
|---|
| 194 | .S FIELD=""
|
|---|
| 195 | .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
|
|---|
| 196 | ..I +LINE1<1 Q
|
|---|
| 197 | ..S FIELD=FIELD_$P(LINE1,U)_";"
|
|---|
| 198 | .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
|
|---|
| 199 | Q
|
|---|
| 200 | ;
|
|---|
| 201 | SORT ;
|
|---|
| 202 | N DESCEND,FIELD,LINE,LINE1,NUM,SUBNUM
|
|---|
| 203 | 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
|
|---|
| 204 | .S FIELD="",DESCEND=""
|
|---|
| 205 | .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
|
|---|
| 206 | ..I +LINE1<1 Q
|
|---|
| 207 | ..S DESCEND=$P(LINE1,U,8) I 'DESCEND S DESCEND=0
|
|---|
| 208 | ..S FIELD=FIELD_$P(LINE1,U)_":"_DESCEND_";"
|
|---|
| 209 | .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
|
|---|
| 210 | Q
|
|---|
| 211 | ;
|
|---|
| 212 | DISPLAY ;
|
|---|
| 213 | N FIELD,LINE,LINE1,NUM,SUBNUM
|
|---|
| 214 | 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
|
|---|
| 215 | .S FIELD=""
|
|---|
| 216 | .S SUBNUM=0 F S SUBNUM=$O(^FSC("FORMAT",NUM,2,SUBNUM)) Q:SUBNUM<1 S LINE1=$G(^(SUBNUM,0)) D
|
|---|
| 217 | ..I +LINE1<1 Q
|
|---|
| 218 | ..S FIELD=FIELD_$P(LINE1,U)_";"
|
|---|
| 219 | .S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_LINE S $P(^(NUM),U,7)=FIELD
|
|---|
| 220 | Q
|
|---|
| 221 | ;
|
|---|
| 222 | CLISTS ;
|
|---|
| 223 | N CNT,LIST,LISTNAME,NUM,ZERO
|
|---|
| 224 | S CNT=0
|
|---|
| 225 | S LISTNAME="" F S LISTNAME=$O(^FSC("LIST","B",LISTNAME)) Q:LISTNAME="" D
|
|---|
| 226 | .S NUM=0 F S NUM=$O(^FSC("LIST","B",LISTNAME,NUM)) Q:NUM<1 D
|
|---|
| 227 | ..S ZERO=$G(^FSC("LIST",NUM,0))
|
|---|
| 228 | ..I $L(ZERO),'$P(ZERO,U,2) D
|
|---|
| 229 | ...S CNT=CNT+1
|
|---|
| 230 | ...S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=NUM_U_ZERO
|
|---|
| 231 | Q
|
|---|
| 232 | ;
|
|---|
| 233 | ULISTS ;
|
|---|
| 234 | N CNT,LINE,LIST,LISTNAME,NUM,USER,ZERO K ^TMP("FSC MERGE",$J)
|
|---|
| 235 | S USER=+$P(FILE,";",2)
|
|---|
| 236 | I '$D(^VA(200,USER,0)) Q
|
|---|
| 237 | S CNT=0
|
|---|
| 238 | S NUM=0 F S NUM=$O(^FSC("LIST","C",USER,NUM)) Q:NUM<1 D
|
|---|
| 239 | .S ZERO=$G(^FSC("LIST",NUM,0))
|
|---|
| 240 | .Q:'$L(ZERO) Q:$P(ZERO,U,2)'=USER
|
|---|
| 241 | .S ^TMP("FSC MERGE",$J,$P(ZERO,U),NUM)=NUM_U_ZERO
|
|---|
| 242 | S CNT=0
|
|---|
| 243 | S LISTNAME="" F S LISTNAME=$O(^TMP("FSC MERGE",$J,LISTNAME)) Q:LISTNAME="" D
|
|---|
| 244 | .S NUM=0 F S NUM=$O(^TMP("FSC MERGE",$J,LISTNAME,NUM)) Q:NUM<1 S LINE=^(NUM) D
|
|---|
| 245 | ..S CNT=CNT+1
|
|---|
| 246 | ..S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
|
|---|
| 247 | K ^TMP("FSC MERGE",$J)
|
|---|
| 248 | Q
|
|---|
