FSCRPCTF ;SLC/STAFF-NOIS RPC Text Finder ;5/18/98 14:58
;;1.1;NOIS;;Sep 06, 1998
;
TEXT(IN,OUT) ; from FSCRPX (RPCTextFinder)
N CNT,FIELDS,LINE,METHOD,NUM,TEXT K TEXT
S METHOD=$G(^TMP("FSCRPC",$J,"INPUT",1)),FIELDS=$G(^(2))
Q:'$L(METHOD) Q:'$L(FIELDS)
S CNT=0,NUM=2 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) D
.I '$L(LINE) Q
.S CNT=CNT+1
.S TEXT(CNT)=$$UP^XLFSTR(LINE)
I '$O(TEXT(0)) Q
D
.I METHOD=1 D CURRENT(FIELDS,.TEXT) Q
.I +METHOD=2 D LAST(FIELDS,.TEXT,+$P(METHOD,";",2)) Q
K TEXT
Q
;
CURRENT(FIELDS,TEXT) ;
N CALL,CNT
K ^TMP("FSC LIST",$J)
S CNT=0,CALL=0 F S CALL=$O(^TMP("FSC CURRENT LIST",$J,"C",CALL)) Q:CALL<1 D ROUTE(CALL,FIELDS,.TEXT,.CNT)
K ^TMP("FSC CURRENT LIST",$J)
M ^TMP("FSC CURRENT LIST",$J)=^TMP("FSC LIST",$J)
K ^TMP("FSC LIST",$J)
S CNT=0 F S CNT=$O(^TMP("FSC CURRENT LIST",$J,CNT)) Q:CNT<1 S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=^(CNT)
Q
;
LAST(FIELDS,TEXT,LAST) ;
N CALL,CNT,NUM
K ^TMP("FSC LIST",$J)
S NUM=0,CNT=0,CALL="A" F S CALL=$O(^FSCD("CALL",CALL),-1) Q:CALL="" S NUM=NUM+1 Q:NUM>LAST D ROUTE(CALL,FIELDS,.TEXT,.CNT)
K ^TMP("FSC CURRENT LIST",$J)
M ^TMP("FSC CURRENT LIST",$J)=^TMP("FSC LIST",$J)
K ^TMP("FSC LIST",$J)
S CNT=0 F S CNT=$O(^TMP("FSC CURRENT LIST",$J,CNT)) Q:CNT<1 S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=^(CNT)
Q
;
ROUTE(CALL,FIELDS,TEXT,CNT) ;
N IEN,OK
S OK=0
D
.S IEN=+$G(^FSCD("CALL USER","AUC",DUZ,CALL))
.I IEN D I OK Q
..I $P(FIELDS,U,8) D PSHORT(IEN,.TEXT,.OK) I OK Q
..I $P(FIELDS,U,9) D PLONG(IEN,.TEXT,.OK) I OK Q
..I $P(FIELDS,U,7) D PNOTE(IEN,.TEXT,.OK) I OK Q
.I $P(FIELDS,U) D SUBJECT(CALL,.TEXT,.OK) I OK Q
.I $P(FIELDS,U,2) D KEYWORDS(CALL,.TEXT,.OK) I OK Q
.I $P(FIELDS,U,3) D PATCH(CALL,.TEXT,.OK) I OK Q
.I $P(FIELDS,U,4) D DESC(CALL,.TEXT,.OK) I OK Q
.I $P(FIELDS,U,5) D RES(CALL,.TEXT,.OK) I OK Q
.I $P(FIELDS,U,6) D NOTES(CALL,.TEXT,.OK) I OK Q
I 'OK Q
S CNT=CNT+1
S ^TMP("FSC LIST",$J,CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
S ^TMP("FSC LIST",$J,"C",CALL)=CNT
Q
;
SUBJECT(CALL,TEXT,OK) ;
N NUM,SUBJECT
S SUBJECT=$G(^FSCD("CALL",CALL,1))
I '$L(SUBJECT) Q
S SUBJECT=$$UP^XLFSTR(SUBJECT)
S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I SUBJECT[TEXT(NUM) S OK=1 Q
Q
;
KEYWORDS(CALL,TEXT,OK) ;
N KEYWORDS,NUM
S KEYWORDS=$G(^FSCD("CALL",CALL,1.5))
I '$L(KEYWORDS) Q
S KEYWORDS=$$UP^XLFSTR(KEYWORDS)
S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I KEYWORDS[TEXT(NUM) S OK=1 Q
Q
;
PATCH(CALL,TEXT,OK) ;
N NUM,PATCH
S PATCH=$P($G(^FSCD("CALL",CALL,120)),U,14)
I '$L(PATCH) Q
S PATCH=$$UP^XLFSTR(PATCH)
S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I PATCH[TEXT(NUM) S OK=1 Q
Q
;
DESC(CALL,TEXT,OK) ;
N LNUM,NUM,LINE
S LNUM=0 F S LNUM=$O(^FSCD("CALL",CALL,30,LNUM)) Q:LNUM<1 S LINE=$G(^(LNUM,0)) D Q:OK
.I '$L(LINE) Q
.S LINE=$$UP^XLFSTR(LINE)
.S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I LINE[TEXT(NUM) S OK=1 Q
S LNUM=0 F S LNUM=$O(^FSCD("CALL",CALL,30,LNUM)) Q:LNUM<1 S LINE=$G(^(LNUM,0)) D Q:OK
.I '$L(LINE) Q
.S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I LINE[TEXT(NUM) S OK=1 Q
Q
;
RES(CALL,TEXT,OK) ;
N LNUM,NUM,LINE
S LNUM=0 F S LNUM=$O(^FSCD("CALL",CALL,80,LNUM)) Q:LNUM<1 S LINE=$G(^(LNUM,0)) D Q:OK
.I '$L(LINE) Q
.S LINE=$$UP^XLFSTR(LINE)
.S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I LINE[TEXT(NUM) S OK=1 Q
Q
;
NOTES(CALL,TEXT,OK) ;
N LNUM,NUM,LINE
S LNUM=0 F S LNUM=$O(^FSCD("CALL",CALL,50,LNUM)) Q:LNUM<1 S LINE=$G(^(LNUM,0)) D Q:OK
.I '$L(LINE) Q
.S LINE=$$UP^XLFSTR(LINE)
.S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I LINE[TEXT(NUM) S OK=1 Q
Q
;
PSHORT(IEN,TEXT,OK) ;
N NUM,PSHORT
S PSHORT=$P($G(^FSCD("CALL USER",IEN,0)),U,3)
I '$L(PSHORT) Q
S PSHORT=$$UP^XLFSTR(PSHORT)
S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I PSHORT[TEXT(NUM) S OK=1 Q
Q
;
PLONG(IEN,TEXT,OK) ;
N NUM,PLONG
S PLONG=$G(^FSCD("CALL USR",IEN,1))
I '$L(PLONG) Q
S PLONG=$$UP^XLFSTR(PLONG)
S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I PLONG[TEXT(NUM) S OK=1 Q
Q
;
PNOTE(IEN,TEXT,OK) ;
N LNUM,NUM,LINE
S LNUM=0 F S LNUM=$O(^FSCD("CALL USER",IEN,2,LNUM)) Q:LNUM<1 S LINE=$G(^(LNUM,0)) D Q:OK
.I '$L(LINE) Q
.S LINE=$$UP^XLFSTR(LINE)
.S NUM=0 F S NUM=$O(TEXT(NUM)) Q:NUM<1 I LINE[TEXT(NUM) S OK=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCTF 4301 printed Oct 16, 2024@18:20:27 Page 2
FSCRPCTF ;SLC/STAFF-NOIS RPC Text Finder ;5/18/98 14:58
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
TEXT(IN,OUT) ; from FSCRPX (RPCTextFinder)
+1 NEW CNT,FIELDS,LINE,METHOD,NUM,TEXT
KILL TEXT
+2 SET METHOD=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
SET FIELDS=$GET(^(2))
+3 if '$LENGTH(METHOD)
QUIT
if '$LENGTH(FIELDS)
QUIT
+4 SET CNT=0
SET NUM=2
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+5 IF '$LENGTH(LINE)
QUIT
+6 SET CNT=CNT+1
+7 SET TEXT(CNT)=$$UP^XLFSTR(LINE)
End DoDot:1
+8 IF '$ORDER(TEXT(0))
QUIT
+9 Begin DoDot:1
+10 IF METHOD=1
DO CURRENT(FIELDS,.TEXT)
QUIT
+11 IF +METHOD=2
DO LAST(FIELDS,.TEXT,+$PIECE(METHOD,";",2))
QUIT
End DoDot:1
+12 KILL TEXT
+13 QUIT
+14 ;
CURRENT(FIELDS,TEXT) ;
+1 NEW CALL,CNT
+2 KILL ^TMP("FSC LIST",$JOB)
+3 SET CNT=0
SET CALL=0
FOR
SET CALL=$ORDER(^TMP("FSC CURRENT LIST",$JOB,"C",CALL))
if CALL<1
QUIT
DO ROUTE(CALL,FIELDS,.TEXT,.CNT)
+4 KILL ^TMP("FSC CURRENT LIST",$JOB)
+5 MERGE ^TMP("FSC CURRENT LIST",$JOB)=^TMP("FSC LIST",$JOB)
+6 KILL ^TMP("FSC LIST",$JOB)
+7 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("FSC CURRENT LIST",$JOB,CNT))
if CNT<1
QUIT
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=^(CNT)
+8 QUIT
+9 ;
LAST(FIELDS,TEXT,LAST) ;
+1 NEW CALL,CNT,NUM
+2 KILL ^TMP("FSC LIST",$JOB)
+3 SET NUM=0
SET CNT=0
SET CALL="A"
FOR
SET CALL=$ORDER(^FSCD("CALL",CALL),-1)
if CALL=""
QUIT
SET NUM=NUM+1
if NUM>LAST
QUIT
DO ROUTE(CALL,FIELDS,.TEXT,.CNT)
+4 KILL ^TMP("FSC CURRENT LIST",$JOB)
+5 MERGE ^TMP("FSC CURRENT LIST",$JOB)=^TMP("FSC LIST",$JOB)
+6 KILL ^TMP("FSC LIST",$JOB)
+7 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("FSC CURRENT LIST",$JOB,CNT))
if CNT<1
QUIT
SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=^(CNT)
+8 QUIT
+9 ;
ROUTE(CALL,FIELDS,TEXT,CNT) ;
+1 NEW IEN,OK
+2 SET OK=0
+3 Begin DoDot:1
+4 SET IEN=+$GET(^FSCD("CALL USER","AUC",DUZ,CALL))
+5 IF IEN
Begin DoDot:2
+6 IF $PIECE(FIELDS,U,8)
DO PSHORT(IEN,.TEXT,.OK)
IF OK
QUIT
+7 IF $PIECE(FIELDS,U,9)
DO PLONG(IEN,.TEXT,.OK)
IF OK
QUIT
+8 IF $PIECE(FIELDS,U,7)
DO PNOTE(IEN,.TEXT,.OK)
IF OK
QUIT
End DoDot:2
IF OK
QUIT
+9 IF $PIECE(FIELDS,U)
DO SUBJECT(CALL,.TEXT,.OK)
IF OK
QUIT
+10 IF $PIECE(FIELDS,U,2)
DO KEYWORDS(CALL,.TEXT,.OK)
IF OK
QUIT
+11 IF $PIECE(FIELDS,U,3)
DO PATCH(CALL,.TEXT,.OK)
IF OK
QUIT
+12 IF $PIECE(FIELDS,U,4)
DO DESC(CALL,.TEXT,.OK)
IF OK
QUIT
+13 IF $PIECE(FIELDS,U,5)
DO RES(CALL,.TEXT,.OK)
IF OK
QUIT
+14 IF $PIECE(FIELDS,U,6)
DO NOTES(CALL,.TEXT,.OK)
IF OK
QUIT
End DoDot:1
+15 IF 'OK
QUIT
+16 SET CNT=CNT+1
+17 SET ^TMP("FSC LIST",$JOB,CNT)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+18 SET ^TMP("FSC LIST",$JOB,"C",CALL)=CNT
+19 QUIT
+20 ;
SUBJECT(CALL,TEXT,OK) ;
+1 NEW NUM,SUBJECT
+2 SET SUBJECT=$GET(^FSCD("CALL",CALL,1))
+3 IF '$LENGTH(SUBJECT)
QUIT
+4 SET SUBJECT=$$UP^XLFSTR(SUBJECT)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF SUBJECT[TEXT(NUM)
SET OK=1
QUIT
+6 QUIT
+7 ;
KEYWORDS(CALL,TEXT,OK) ;
+1 NEW KEYWORDS,NUM
+2 SET KEYWORDS=$GET(^FSCD("CALL",CALL,1.5))
+3 IF '$LENGTH(KEYWORDS)
QUIT
+4 SET KEYWORDS=$$UP^XLFSTR(KEYWORDS)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF KEYWORDS[TEXT(NUM)
SET OK=1
QUIT
+6 QUIT
+7 ;
PATCH(CALL,TEXT,OK) ;
+1 NEW NUM,PATCH
+2 SET PATCH=$PIECE($GET(^FSCD("CALL",CALL,120)),U,14)
+3 IF '$LENGTH(PATCH)
QUIT
+4 SET PATCH=$$UP^XLFSTR(PATCH)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF PATCH[TEXT(NUM)
SET OK=1
QUIT
+6 QUIT
+7 ;
DESC(CALL,TEXT,OK) ;
+1 NEW LNUM,NUM,LINE
+2 SET LNUM=0
FOR
SET LNUM=$ORDER(^FSCD("CALL",CALL,30,LNUM))
if LNUM<1
QUIT
SET LINE=$GET(^(LNUM,0))
Begin DoDot:1
+3 IF '$LENGTH(LINE)
QUIT
+4 SET LINE=$$UP^XLFSTR(LINE)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF LINE[TEXT(NUM)
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+6 SET LNUM=0
FOR
SET LNUM=$ORDER(^FSCD("CALL",CALL,30,LNUM))
if LNUM<1
QUIT
SET LINE=$GET(^(LNUM,0))
Begin DoDot:1
+7 IF '$LENGTH(LINE)
QUIT
+8 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF LINE[TEXT(NUM)
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+9 QUIT
+10 ;
RES(CALL,TEXT,OK) ;
+1 NEW LNUM,NUM,LINE
+2 SET LNUM=0
FOR
SET LNUM=$ORDER(^FSCD("CALL",CALL,80,LNUM))
if LNUM<1
QUIT
SET LINE=$GET(^(LNUM,0))
Begin DoDot:1
+3 IF '$LENGTH(LINE)
QUIT
+4 SET LINE=$$UP^XLFSTR(LINE)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF LINE[TEXT(NUM)
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+6 QUIT
+7 ;
NOTES(CALL,TEXT,OK) ;
+1 NEW LNUM,NUM,LINE
+2 SET LNUM=0
FOR
SET LNUM=$ORDER(^FSCD("CALL",CALL,50,LNUM))
if LNUM<1
QUIT
SET LINE=$GET(^(LNUM,0))
Begin DoDot:1
+3 IF '$LENGTH(LINE)
QUIT
+4 SET LINE=$$UP^XLFSTR(LINE)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF LINE[TEXT(NUM)
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+6 QUIT
+7 ;
PSHORT(IEN,TEXT,OK) ;
+1 NEW NUM,PSHORT
+2 SET PSHORT=$PIECE($GET(^FSCD("CALL USER",IEN,0)),U,3)
+3 IF '$LENGTH(PSHORT)
QUIT
+4 SET PSHORT=$$UP^XLFSTR(PSHORT)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF PSHORT[TEXT(NUM)
SET OK=1
QUIT
+6 QUIT
+7 ;
PLONG(IEN,TEXT,OK) ;
+1 NEW NUM,PLONG
+2 SET PLONG=$GET(^FSCD("CALL USR",IEN,1))
+3 IF '$LENGTH(PLONG)
QUIT
+4 SET PLONG=$$UP^XLFSTR(PLONG)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF PLONG[TEXT(NUM)
SET OK=1
QUIT
+6 QUIT
+7 ;
PNOTE(IEN,TEXT,OK) ;
+1 NEW LNUM,NUM,LINE
+2 SET LNUM=0
FOR
SET LNUM=$ORDER(^FSCD("CALL USER",IEN,2,LNUM))
if LNUM<1
QUIT
SET LINE=$GET(^(LNUM,0))
Begin DoDot:1
+3 IF '$LENGTH(LINE)
QUIT
+4 SET LINE=$$UP^XLFSTR(LINE)
+5 SET NUM=0
FOR
SET NUM=$ORDER(TEXT(NUM))
if NUM<1
QUIT
IF LINE[TEXT(NUM)
SET OK=1
QUIT
End DoDot:1
if OK
QUIT
+6 QUIT
