FSCRPCSF ;SLC/STAFF-NOIS RPC Static File ;2/21/97 17:31
;;1.1;NOIS;;Sep 06, 1998
;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
N FILE,NUM
S FILE=$P($G(^TMP("FSCRPC",$J,"INPUT",1)),U,1)
I '$L(FILE) Q
I FILE="SPEC" D SPEC Q
I FILE="FORMAT_SORT" D SORT Q
I FILE="FORMAT_DISPLAY" D DISPLAY Q
I '$D(^FSC(FILE,0)) Q
S NUM=0 F S NUM=$O(^FSC(FILE,NUM)) Q:NUM<1 S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=NUM_U_^(NUM,0)
Q
;
SPEC ;
N DATA,NUM,UNUM
S NUM=0
S UNUM=0 F S UNUM=$O(^FSC("SPEC",UNUM)) Q:UNUM<1 S DATA=$G(^(UNUM,0)) I $L(DATA) D
.S NUM=NUM+1
.S ^TMP("FSCRPC",$J,"OUTPUT",NUM)=UNUM_U_$P($G(^VA(200,UNUM,0)),U)_$P(DATA,U,2,99)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCSF 1487 printed Nov 22, 2024@17:29:47 Page 2
FSCRPCSF ;SLC/STAFF-NOIS RPC Static File ;2/21/97 17:31
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
FILE(IN,OUT) ; from FSCRPX (RPCStaticFile)
+1 NEW FILE,NUM
+2 SET FILE=$PIECE($GET(^TMP("FSCRPC",$JOB,"INPUT",1)),U,1)
+3 IF '$LENGTH(FILE)
QUIT
+4 IF FILE="SPEC"
DO SPEC
QUIT
+5 IF FILE="FORMAT_SORT"
DO SORT
QUIT
+6 IF FILE="FORMAT_DISPLAY"
DO DISPLAY
QUIT
+7 IF '$DATA(^FSC(FILE,0))
QUIT
+8 SET NUM=0
FOR
SET NUM=$ORDER(^FSC(FILE,NUM))
if NUM<1
QUIT
SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=NUM_U_^(NUM,0)
+9 QUIT
+10 ;
SPEC ;
+1 NEW DATA,NUM,UNUM
+2 SET NUM=0
+3 SET UNUM=0
FOR
SET UNUM=$ORDER(^FSC("SPEC",UNUM))
if UNUM<1
QUIT
SET DATA=$GET(^(UNUM,0))
IF $LENGTH(DATA)
Begin DoDot:1
+4 SET NUM=NUM+1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUT",NUM)=UNUM_U_$PIECE($GET(^VA(200,UNUM,0)),U)_$PIECE(DATA,U,2,99)
End DoDot:1
+6 QUIT
+7 ;
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
