FSCEU ;SLC/STAFF-NOIS Edit Utilities ;9/6/98 20:39
;;1.1;NOIS;;Sep 06, 1998
;
UPDATE(CALL) ; from FSCEN, FSCLMPE1, FSCLMPEA, FSCLMPES
D UPDATE^FSCAUDIT(CALL)
D UPDATE^FSCTASK(CALL)
D BUILD(CALL)
Q
;
BUILD(CALL) ; from FSCELL, FSCLMPE1
N LINE,SHORT
D BUILD^FSCFORM(FSCCNT,CALL,.FSCSTYLE,0,"FSC MULT ")
S SHORT=$$SHORT^FSCGETS(CALL,FSCCNT),LINE=+$O(^TMP("FSC LIST CALLS",$J,"IDX",FSCCNT,0))
S ^TMP("FSC LIST CALLS",$J,LINE,0)=SHORT
S $P(^TMP("FSC MULT",$J,FSCCNT),U,2)=SHORT
S VALMHDR(1)=SHORT
I $L($G(FSCLNAME)),FSCLNAME'["(MODIFIED)" S FSCLNAME=FSCLNAME_" (MODIFIED)"
S FSCEDIT=1
S VALMCNT=+$P(@VALMAR,U,2),VALMBG=1
Q
;
WP(NAME,PROMPT) ; from FSCEC, FSCEN, FSCNMS
N CNT,DIC,DWLW,DWPK,LINE,TEXTNUM K DIC
K ^TMP("FSC TEXT",$J,NAME)
L +^FSCD("TEXT",0):30 I '$T D SOMEONE^FSCLMPE1 Q
S TEXTNUM=$P(^FSCD("TEXT",0),U,4)+1
F Q:'$D(^FSCD("TEXT",TEXTNUM,0)) S TEXTNUM=TEXTNUM+1
S $P(^FSCD("TEXT",0),U,3)=TEXTNUM,$P(^(0),U,4)=$P(^(0),U,4)+1
S ^FSCD("TEXT",TEXTNUM,0)=TEXTNUM
L -^FSCD("TEXT",0)
I $L($G(PROMPT)) W !,PROMPT
S DIC="^FSCD(""TEXT"","_TEXTNUM_",1,",DWLW=80,DWPK=1 D EN^DIWE K DIC
S (CNT,LINE)=0 F S LINE=$O(^FSCD("TEXT",TEXTNUM,1,LINE)) Q:LINE<1 S ^TMP("FSC TEXT",$J,NAME,LINE,0)=^(LINE,0),CNT=CNT+1
I $D(^TMP("FSC TEXT",$J,NAME)) S ^(NAME)=CNT
L +^FSCD("TEXT",0):30 I '$T D SOMEONE^FSCLMPE1 Q
K ^FSCD("TEXT",TEXTNUM)
S $P(^(0),U,4)=$P(^FSCD("TEXT",0),U,4)-1
L -^FSCD("TEXT",0)
Q
;
EDITWP(ARRAY,PROMPT) ; from FSCEC, FSCEN, FSCMU1, FSCNMS
; only ^TMP("FSC ... globals can be edited
I $E(ARRAY)=U,$E(ARRAY,1,9)'="^TMP(""FSC" Q
N CNT,DIC,DWLW,DWPK,LINE,TEXT,TEXTNUM K DIC
L +^FSCD("TEXT",0):30 I '$T D SOMEONE^FSCLMPE1 Q
S TEXTNUM=$P(^FSCD("TEXT",0),U,4)+1
F Q:'$D(^FSCD("TEXT",TEXTNUM,0)) S TEXTNUM=TEXTNUM+1
S $P(^FSCD("TEXT",0),U,3)=TEXTNUM,$P(^(0),U,4)=$P(^(0),U,4)+1
S ^FSCD("TEXT",TEXTNUM,0)=TEXTNUM
L -^FSCD("TEXT",0)
I $L($G(PROMPT)) W !,PROMPT
S (CNT,LINE)=0 F S LINE=$O(@ARRAY@(LINE)) Q:LINE<1 D
.S TEXT=@ARRAY@(LINE,0),CNT=CNT+1
.S ^FSCD("TEXT",TEXTNUM,1,CNT,0)=TEXT
I CNT S ^FSCD("TEXT",TEXTNUM,1,0)="^^"_CNT_U_CNT_U_$G(DT)_U
K @ARRAY
S DIC="^FSCD(""TEXT"","_TEXTNUM_",1,",DWLW=80,DWPK=1 D EN^DIWE K DIC
S (CNT,LINE)=0 F S LINE=$O(^FSCD("TEXT",TEXTNUM,1,LINE)) Q:LINE<1 S @ARRAY@(LINE,0)=^(LINE,0),CNT=CNT+1
I $O(@ARRAY@(0)) S @ARRAY=CNT
L +^FSCD("TEXT",0):30 I '$T D SOMEONE^FSCLMPE1 Q
K ^FSCD("TEXT",TEXTNUM)
S $P(^(0),U,4)=$P(^FSCD("TEXT",0),U,4)-1
L -^FSCD("TEXT",0)
Q
;
SUB(CALL) ; $$(call#) -> @2 or @1 if subcomponents should be asked
N MOD
S MOD=+$P($G(^FSCD("CALL",CALL,0)),U,8)
I 'MOD Q "@2"
I $O(^FSC("SUB","AC",+$P($G(^FSC("MOD",MOD,0)),U,8),0)) Q "@1"
Q "@2"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFSCEU 2729 printed Apr 09, 2024@21:21:37 Page 2
FSCEU ;SLC/STAFF-NOIS Edit Utilities ;9/6/98 20:39
+1 ;;1.1;NOIS;;Sep 06, 1998
+2 ;
UPDATE(CALL) ; from FSCEN, FSCLMPE1, FSCLMPEA, FSCLMPES
+1 DO UPDATE^FSCAUDIT(CALL)
+2 DO UPDATE^FSCTASK(CALL)
+3 DO BUILD(CALL)
+4 QUIT
+5 ;
BUILD(CALL) ; from FSCELL, FSCLMPE1
+1 NEW LINE,SHORT
+2 DO BUILD^FSCFORM(FSCCNT,CALL,.FSCSTYLE,0,"FSC MULT ")
+3 SET SHORT=$$SHORT^FSCGETS(CALL,FSCCNT)
SET LINE=+$ORDER(^TMP("FSC LIST CALLS",$JOB,"IDX",FSCCNT,0))
+4 SET ^TMP("FSC LIST CALLS",$JOB,LINE,0)=SHORT
+5 SET $PIECE(^TMP("FSC MULT",$JOB,FSCCNT),U,2)=SHORT
+6 SET VALMHDR(1)=SHORT
+7 IF $LENGTH($GET(FSCLNAME))
IF FSCLNAME'["(MODIFIED)"
SET FSCLNAME=FSCLNAME_" (MODIFIED)"
+8 SET FSCEDIT=1
+9 SET VALMCNT=+$PIECE(@VALMAR,U,2)
SET VALMBG=1
+10 QUIT
+11 ;
WP(NAME,PROMPT) ; from FSCEC, FSCEN, FSCNMS
+1 NEW CNT,DIC,DWLW,DWPK,LINE,TEXTNUM
KILL DIC
+2 KILL ^TMP("FSC TEXT",$JOB,NAME)
+3 LOCK +^FSCD("TEXT",0):30
IF '$TEST
DO SOMEONE^FSCLMPE1
QUIT
+4 SET TEXTNUM=$PIECE(^FSCD("TEXT",0),U,4)+1
+5 FOR
if '$DATA(^FSCD("TEXT",TEXTNUM,0))
QUIT
SET TEXTNUM=TEXTNUM+1
+6 SET $PIECE(^FSCD("TEXT",0),U,3)=TEXTNUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+7 SET ^FSCD("TEXT",TEXTNUM,0)=TEXTNUM
+8 LOCK -^FSCD("TEXT",0)
+9 IF $LENGTH($GET(PROMPT))
WRITE !,PROMPT
+10 SET DIC="^FSCD(""TEXT"","_TEXTNUM_",1,"
SET DWLW=80
SET DWPK=1
DO EN^DIWE
KILL DIC
+11 SET (CNT,LINE)=0
FOR
SET LINE=$ORDER(^FSCD("TEXT",TEXTNUM,1,LINE))
if LINE<1
QUIT
SET ^TMP("FSC TEXT",$JOB,NAME,LINE,0)=^(LINE,0)
SET CNT=CNT+1
+12 IF $DATA(^TMP("FSC TEXT",$JOB,NAME))
SET ^(NAME)=CNT
+13 LOCK +^FSCD("TEXT",0):30
IF '$TEST
DO SOMEONE^FSCLMPE1
QUIT
+14 KILL ^FSCD("TEXT",TEXTNUM)
+15 SET $PIECE(^(0),U,4)=$PIECE(^FSCD("TEXT",0),U,4)-1
+16 LOCK -^FSCD("TEXT",0)
+17 QUIT
+18 ;
EDITWP(ARRAY,PROMPT) ; from FSCEC, FSCEN, FSCMU1, FSCNMS
+1 ; only ^TMP("FSC ... globals can be edited
+2 IF $EXTRACT(ARRAY)=U
IF $EXTRACT(ARRAY,1,9)'="^TMP(""FSC"
QUIT
+3 NEW CNT,DIC,DWLW,DWPK,LINE,TEXT,TEXTNUM
KILL DIC
+4 LOCK +^FSCD("TEXT",0):30
IF '$TEST
DO SOMEONE^FSCLMPE1
QUIT
+5 SET TEXTNUM=$PIECE(^FSCD("TEXT",0),U,4)+1
+6 FOR
if '$DATA(^FSCD("TEXT",TEXTNUM,0))
QUIT
SET TEXTNUM=TEXTNUM+1
+7 SET $PIECE(^FSCD("TEXT",0),U,3)=TEXTNUM
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+8 SET ^FSCD("TEXT",TEXTNUM,0)=TEXTNUM
+9 LOCK -^FSCD("TEXT",0)
+10 IF $LENGTH($GET(PROMPT))
WRITE !,PROMPT
+11 SET (CNT,LINE)=0
FOR
SET LINE=$ORDER(@ARRAY@(LINE))
if LINE<1
QUIT
Begin DoDot:1
+12 SET TEXT=@ARRAY@(LINE,0)
SET CNT=CNT+1
+13 SET ^FSCD("TEXT",TEXTNUM,1,CNT,0)=TEXT
End DoDot:1
+14 IF CNT
SET ^FSCD("TEXT",TEXTNUM,1,0)="^^"_CNT_U_CNT_U_$GET(DT)_U
+15 KILL @ARRAY
+16 SET DIC="^FSCD(""TEXT"","_TEXTNUM_",1,"
SET DWLW=80
SET DWPK=1
DO EN^DIWE
KILL DIC
+17 SET (CNT,LINE)=0
FOR
SET LINE=$ORDER(^FSCD("TEXT",TEXTNUM,1,LINE))
if LINE<1
QUIT
SET @ARRAY@(LINE,0)=^(LINE,0)
SET CNT=CNT+1
+18 IF $ORDER(@ARRAY@(0))
SET @ARRAY=CNT
+19 LOCK +^FSCD("TEXT",0):30
IF '$TEST
DO SOMEONE^FSCLMPE1
QUIT
+20 KILL ^FSCD("TEXT",TEXTNUM)
+21 SET $PIECE(^(0),U,4)=$PIECE(^FSCD("TEXT",0),U,4)-1
+22 LOCK -^FSCD("TEXT",0)
+23 QUIT
+24 ;
SUB(CALL) ; $$(call#) -> @2 or @1 if subcomponents should be asked
+1 NEW MOD
+2 SET MOD=+$PIECE($GET(^FSCD("CALL",CALL,0)),U,8)
+3 IF 'MOD
QUIT "@2"
+4 IF $ORDER(^FSC("SUB","AC",+$PIECE($GET(^FSC("MOD",MOD,0)),U,8),0))
QUIT "@1"
+5 QUIT "@2"
