FSCRPCLO ;SLC/STAFF-NOIS RPC List Organizer ;4/20/98 13:29
;;1.1;NOIS;;Sep 06, 1998
;
LOADLIST(IN,OUT) ; from FSCRPX (RPCLoadCurrentList)
N CALL,CNT,LINE,LNUM
S CNT=0
S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S CALL=+^(LNUM) D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=CALL_U_$$TEXTID(CALL)
Q
;
RENAME(IN,OUT) ; from FSCRPX (RPCRenameList)
N DA,DATA,DIE,DR,LIST,NAME,X,Y
S DATA=$G(^TMP("FSCRPC",$J,"INPUT",1))
S LIST=+DATA,NAME=$P(DATA,U,2)
I '$D(^FSC("LIST",LIST,0)) Q
I $L(NAME)<3 Q
S DA=LIST,DIE="^FSC(""LIST"",",DR=".01///"_$$FIX^FSCRPCEC($E(NAME,1,30))
D ^DIE
Q
;
UPLIST(IN,OUT) ; from FSCRPX (RPCUpdateCurrentList)
N CNT,LINE,LNUM
S CNT=0
S LNUM=0 F S LNUM=$O(^TMP("FSC CURRENT LIST",$J,LNUM)) Q:LNUM<1 S LINE=^(LNUM) D
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LINE
Q
;
DELLIST(IN,OUT) ; from FSCRPX (RPCDeleteList)
N CALL,DA,DIE,DIK,DR,LISTNUM,LISTSNUM,SPEC
S LISTNUM=+$G(^TMP("FSCRPC",$J,"INPUT",1))
I '$D(^FSC("LIST","C",DUZ,LISTNUM)) Q
S CALL=0 F S CALL=$O(^FSCD("LISTS","ALC",LISTNUM,CALL)) Q:CALL<1 S LISTSNUM=+$O(^(CALL,0)) I LISTSNUM D DELETE^FSCLMPS(LISTSNUM)
S DIE=7105.2,DR="9///@"
S SPEC=0 F S SPEC=$O(^FSC("SPEC","AL",LISTNUM,SPEC)) Q:SPEC<1 D
.S DA=SPEC
.L +^FSC("SPEC",SPEC):30
.D ^DIE
.L -^FSC("SPEC",SPEC)
N DA,DIK,NOTIFY
S DIK="^FSCD(""NOTIFY"","
S NOTIFY=0 F S NOTIFY=$O(^FSCD("NOTIFY","ALIST",LISTNUM,NOTIFY)) Q:NOTIFY<1 D
.S DA=NOTIFY
.L +^FSCD("NOTIFY",NOTIFY):30
.D ^DIK
.L -^FSCD("NOTIFY",NOTIFY)
D DELMRU^FSCLDR(LISTNUM)
S DA=LISTNUM,DIK="^FSC(""LIST""," D ^DIK
Q
;
DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
Q
;
LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
N CALL,CNT,LIST,LISTNAME
S CNT=0
S LIST=0 F S LIST=$O(^FSC("LIST","C",DUZ,LIST)) Q:LIST<1 D
.Q:$P($G(^FSC("LIST",LIST,0)),U,3)'="S" S LISTNAME=$P(^(0),U)
.S CNT=CNT+1
.S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LIST_"^-1^"_LISTNAME
.S CALL="" F S CALL=$O(^FSCD("LISTS","ALC",LIST,CALL),-1) Q:CALL="" D
..S CNT=CNT+1
..S ^TMP("FSCRPC",$J,"OUTPUT",CNT)=LIST_U_CALL_U_$$TEXTID(CALL)
Q
;
TEXTID(CALL) ; $$(call) -> text for tree display
Q $P(^FSCD("CALL",CALL,0),U)_" "_$G(^FSCD("CALL",CALL,1))
;
SAVELIST(IN,OUT) ; from FSCRPX (RPCSaveOrganizer)
N CALL,LINE,LIST,LNUM,NUM,SCALL,SLIST K SLIST
D KILLLIST^FSCRPCL
S LNUM=0
S NUM=0 F S NUM=$O(^TMP("FSCRPC",$J,"INPUT",NUM)) Q:NUM<1 S LINE=^(NUM) I $L(LINE) D
.S LIST=$P(LINE,U),CALL=$P(LINE,U,2)
.I LIST="C" D Q
..S LNUM=LNUM+1
..S ^TMP("FSC CURRENT LIST",$J,LNUM+1000)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
..S ^TMP("FSC CURRENT LIST",$J,"C",CALL)=LNUM+1000
.I '$D(^FSC("LIST","C",DUZ,LIST)) Q
.I '$D(SLIST(LIST)) D
..S SLIST(LIST)=""
..S SCALL=0 F S SCALL=$O(^FSCD("LISTS","ALC",LIST,SCALL)) Q:SCALL<1 S LISTSNUM=+$O(^(SCALL,0)) I LISTSNUM D DELETE^FSCLMPS(LISTSNUM)
.I CALL>0,$D(^FSCD("CALL",CALL,0)) D ADD^FSCLMPS(CALL,LIST)
K SLIST
Q
;
TEST ;
D LOADTREE(.IN,.OUT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCRPCLO 3022 printed Dec 13, 2024@02:19:33 Page 2
FSCRPCLO ;SLC/STAFF-NOIS RPC List Organizer ;4/20/98 13:29
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
LOADLIST(IN,OUT) ; from FSCRPX (RPCLoadCurrentList)
+1 NEW CALL,CNT,LINE,LNUM
+2 SET CNT=0
+3 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,LNUM))
if LNUM<1
QUIT
SET CALL=+^(LNUM)
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=CALL_U_$$TEXTID(CALL)
End DoDot:1
+6 QUIT
+7 ;
RENAME(IN,OUT) ; from FSCRPX (RPCRenameList)
+1 NEW DA,DATA,DIE,DR,LIST,NAME,X,Y
+2 SET DATA=$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 SET LIST=+DATA
SET NAME=$PIECE(DATA,U,2)
+4 IF '$DATA(^FSC("LIST",LIST,0))
QUIT
+5 IF $LENGTH(NAME)<3
QUIT
+6 SET DA=LIST
SET DIE="^FSC(""LIST"","
SET DR=".01///"_$$FIX^FSCRPCEC($EXTRACT(NAME,1,30))
+7 DO ^DIE
+8 QUIT
+9 ;
UPLIST(IN,OUT) ; from FSCRPX (RPCUpdateCurrentList)
+1 NEW CNT,LINE,LNUM
+2 SET CNT=0
+3 SET LNUM=0
FOR
SET LNUM=$ORDER(^TMP("FSC CURRENT LIST",$JOB,LNUM))
if LNUM<1
QUIT
SET LINE=^(LNUM)
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LINE
End DoDot:1
+6 QUIT
+7 ;
DELLIST(IN,OUT) ; from FSCRPX (RPCDeleteList)
+1 NEW CALL,DA,DIE,DIK,DR,LISTNUM,LISTSNUM,SPEC
+2 SET LISTNUM=+$GET(^TMP("FSCRPC",$JOB,"INPUT",1))
+3 IF '$DATA(^FSC("LIST","C",DUZ,LISTNUM))
QUIT
+4 SET CALL=0
FOR
SET CALL=$ORDER(^FSCD("LISTS","ALC",LISTNUM,CALL))
if CALL<1
QUIT
SET LISTSNUM=+$ORDER(^(CALL,0))
IF LISTSNUM
DO DELETE^FSCLMPS(LISTSNUM)
+5 SET DIE=7105.2
SET DR="9///@"
+6 SET SPEC=0
FOR
SET SPEC=$ORDER(^FSC("SPEC","AL",LISTNUM,SPEC))
if SPEC<1
QUIT
Begin DoDot:1
+7 SET DA=SPEC
+8 LOCK +^FSC("SPEC",SPEC):30
+9 DO ^DIE
+10 LOCK -^FSC("SPEC",SPEC)
End DoDot:1
+11 NEW DA,DIK,NOTIFY
+12 SET DIK="^FSCD(""NOTIFY"","
+13 SET NOTIFY=0
FOR
SET NOTIFY=$ORDER(^FSCD("NOTIFY","ALIST",LISTNUM,NOTIFY))
if NOTIFY<1
QUIT
Begin DoDot:1
+14 SET DA=NOTIFY
+15 LOCK +^FSCD("NOTIFY",NOTIFY):30
+16 DO ^DIK
+17 LOCK -^FSCD("NOTIFY",NOTIFY)
End DoDot:1
+18 DO DELMRU^FSCLDR(LISTNUM)
+19 SET DA=LISTNUM
SET DIK="^FSC(""LIST"","
DO ^DIK
+20 QUIT
+21 ;
DUPCALL(IN,OUT) ; from FSCRPX (RPCDuplicateOfCall)
+1 QUIT
+2 ;
LOADTREE(IN,OUT) ; from FSCRPX (RPCLoadTree)
+1 NEW CALL,CNT,LIST,LISTNAME
+2 SET CNT=0
+3 SET LIST=0
FOR
SET LIST=$ORDER(^FSC("LIST","C",DUZ,LIST))
if LIST<1
QUIT
Begin DoDot:1
+4 if $PIECE($GET(^FSC("LIST",LIST,0)),U,3)'="S"
QUIT
SET LISTNAME=$PIECE(^(0),U)
+5 SET CNT=CNT+1
+6 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LIST_"^-1^"_LISTNAME
+7 SET CALL=""
FOR
SET CALL=$ORDER(^FSCD("LISTS","ALC",LIST,CALL),-1)
if CALL=""
QUIT
Begin DoDot:2
+8 SET CNT=CNT+1
+9 SET ^TMP("FSCRPC",$JOB,"OUTPUT",CNT)=LIST_U_CALL_U_$$TEXTID(CALL)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
TEXTID(CALL) ; $$(call) -> text for tree display
+1 QUIT $PIECE(^FSCD("CALL",CALL,0),U)_" "_$GET(^FSCD("CALL",CALL,1))
+2 ;
SAVELIST(IN,OUT) ; from FSCRPX (RPCSaveOrganizer)
+1 NEW CALL,LINE,LIST,LNUM,NUM,SCALL,SLIST
KILL SLIST
+2 DO KILLLIST^FSCRPCL
+3 SET LNUM=0
+4 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("FSCRPC",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
IF $LENGTH(LINE)
Begin DoDot:1
+5 SET LIST=$PIECE(LINE,U)
SET CALL=$PIECE(LINE,U,2)
+6 IF LIST="C"
Begin DoDot:2
+7 SET LNUM=LNUM+1
+8 SET ^TMP("FSC CURRENT LIST",$JOB,LNUM+1000)=CALL_U_$$SHORT^FSCRPXUS(CALL,DUZ)
+9 SET ^TMP("FSC CURRENT LIST",$JOB,"C",CALL)=LNUM+1000
End DoDot:2
QUIT
+10 IF '$DATA(^FSC("LIST","C",DUZ,LIST))
QUIT
+11 IF '$DATA(SLIST(LIST))
Begin DoDot:2
+12 SET SLIST(LIST)=""
+13 SET SCALL=0
FOR
SET SCALL=$ORDER(^FSCD("LISTS","ALC",LIST,SCALL))
if SCALL<1
QUIT
SET LISTSNUM=+$ORDER(^(SCALL,0))
IF LISTSNUM
DO DELETE^FSCLMPS(LISTSNUM)
End DoDot:2
+14 IF CALL>0
IF $DATA(^FSCD("CALL",CALL,0))
DO ADD^FSCLMPS(CALL,LIST)
End DoDot:1
+15 KILL SLIST
+16 QUIT
+17 ;
TEST ;
+1 DO LOADTREE(.IN,.OUT)
+2 QUIT
