FSCRPCLS.m

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 ---FSCRPCLS   8857     printed  Mar 13, 2025@21:24:31                                                                                                                                                                                                    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