SRCUSS2 ;TAMPA/CFB - SCREEN SERVER ; 9 Dec 1988 11:07 AM
;;3.0; Surgery ;;24 Jun 93
K Q("DRR") F Q8=1:1 S Q6=$P(DR,";",Q8) Q:Q6="" S Q("DRR",Q6)=""
K Q("DR") F Q8=2:1 S Q6=$P(Q0(Q,Q0(0,Q)),";",Q8) Q:Q6="" I $D(Q("DRR",Q6)) S Q("DR",Q8-1)=Q6
K Q("DRR")
F Q("X")=0:0 S Q("X")=$O(Q("DR",Q("X"))) Q:Q("X")="" S DR=Q("DR",Q("X")) D ED3
K Q("SC"),Q("X"),Q("DR") Q
ED S DR=DR_"///"_Q8 D ^DIE,SET
ED0 S Q(1,Q)=Q("X"),DY=$P(^TMP("SRCUSS",$J,Q("X"),0),U,1)-1,DX=1 X Q("XY") W ! D A^SRCUSS Q
ED1 I $O(Q("DR",Q("X")))'="" W @IOF X Q(0) F Q6=0:0 S Q6=$O(^TMP("SRCUSS",$J,Q6)) Q:Q6=""!(Q6'=+Q6) S:Q6>Q("X") ^TMP("SRCUSS",$J,Q6,0)=$P(^(Q6,0),U,1)+Q8 X ^TMP("SRCUSS",$J,Q6,1),^(2) ;S DY=+^(0)+1,DX=$P(^(0),U,2) X Q("XY"),^(2)
ED2 S DR=Q("DR",Q("X")),DY=22,DX=1 X Q("XY") W Q("EPE") D ^DIE W $C(13),Q("EOL") S Q("SC")="?" W @IOF,Q("EPE") X Q(0)
W ! F Q8=1:1:^TMP("SRCUSS",$J,0) I $D(^TMP("SRCUSS",$J,Q8,1)) X ^(1) S DY=+^(0)+1,DX=$P(^(0),U,2) X Q("XY"),^(2)
G ED0
ED3 I $D(^TMP("SRCUSS",$J,Q("X"),1)) X ^(1)
E Q
I ^TMP("SRCUSS",$J,Q("X"),2)["(WORD PROCESSING)" D ED2 Q
S @("DX(3)="_Q("BC")),DX(3)=$A(DX(3)),DX(1)=$X,DY(1)=$Y,DX=1,DY=22 X Q("XY")
W Q("EPE"),Q("HI"),"""."" WILL ENTER THE CHARACTER UNDERNEATH, SPACE BAR ENTERS THE NEXT WORD",!," ENTER A ""E"" TO ENTER NEW TEXT AT CURSOR, RETURN TO EXIT",Q("LO") S DX=DX(1),DY=DY(1) X Q("XY")
S (DX(0),DX(1))=$P(^TMP("SRCUSS",$J,Q("X"),0),U,2),(DY(0),DY(1))=+^(0)+1,Q6=$P($P(^(2),$C(34)_",Q(""LO""),",1),"Q(""HI""),"_$C(34),2),Q("T")=0 W Q("REV"),Q("HI")
S Q8="" W ! D RDP,RD Q:'$T S DX=DX(0)-1,DY=DY(0) X Q("XY") W Q("EOL"),Q("NOR"),Q("HI") K Q("SC") D:"?@"[$E(Q8,1)&(Q8'="") ED2 I '$D(Q("SC")) D ED
Q
RD R Q7:DTIME Q:'$T S Q7=$A(Q7) Q:((Q7=13)&('Q("T")))
I Q8="",((Q7=63)!(Q7=64)) S Q8=$C(Q7) Q
I Q7=DX(3),$L(Q8)>0 S Q8=$E(Q8,1,$L(Q8)-1),DX(1)=$X D RDO G RD
I Q7=DX(3) S DX=$X+1,DY=$Y S:DX=81 DX=1,DY=DY+1 X Q("XY") G RD
I 'Q("T"),Q7=69 S Q("T")=1,DX(2)=$E(Q6,$L(Q8)+1,999),DY(2)=$L(Q8) S DX(1)=$X-1 D RDO G RD
I 'Q("T"),'((Q7=46)!(Q7=127)!(Q7=32)) S DX(1)=$X-1 D RDO G RD
I Q("T")=1,Q7=13 S Q("T")=0,DX(2)="" S DX(1)=$X D RDO G RD
I Q7=127,'Q("T") S Q6=$E(Q6,1,$L(Q8))_$E(Q6,$L(Q8)+2,999),DX=$X-1 D RDO G RD
I Q7=127 G:$L(Q8)=DY(2) RD S Q6=$E(Q6,1,$L(Q8)-1)_$E(Q6,$L(Q8)+1,999),Q8=$E(Q8,1,$L(Q8)-1),DX(1)=$X-1 D RDO G RD
I 'Q("T"),(Q7=46) Q:$E(Q6,$L(Q8)+1)="" S Q8=Q8_$E(Q6,$L(Q8)+1),DX(1)=$X,DY(1)=$Y D RDP G RD
I 'Q("T"),Q7=32 S DX(1)=$X,DY(1)=$Y,DY(3)=$F(Q6," ",$L(Q8)+2) S:DY(3)=0 DY(3)=$L(Q6)+1 S DX(1)=DX(0)+DY(3)-1,Q8=Q8_$E(Q6,$L(Q8)+1,DY(3)-1) S:DX(1)>80 DY(1)=DY(1)+DX(1)\80,DX(1)=DX(1)#80 D RDO G RD
S Q8=Q8_$C(Q7),Q6=Q8_DX(2) S DX(1)=$X,DY(1)=$Y D RDP G RD
RDO S DY(1)=$Y S:DX(1)=0 DX(1)=80,DY(1)=DY(1)-1
RDP S:'$D(Q7) Q7=0 S DX=DX(0),DY=DY(0) X Q("XY") W Q6_$S(Q7=127:" ",1:"") S DX=DX(1),DY=DY(1) X Q("XY") Q
SET F Q8=1:1:Q S DA(Q8)=Q(9,Q)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRCUSS2 2863 printed Dec 13, 2024@02:39:08 Page 2
SRCUSS2 ;TAMPA/CFB - SCREEN SERVER ; 9 Dec 1988 11:07 AM
+1 ;;3.0; Surgery ;;24 Jun 93
+2 KILL Q("DRR")
FOR Q8=1:1
SET Q6=$PIECE(DR,";",Q8)
if Q6=""
QUIT
SET Q("DRR",Q6)=""
+3 KILL Q("DR")
FOR Q8=2:1
SET Q6=$PIECE(Q0(Q,Q0(0,Q)),";",Q8)
if Q6=""
QUIT
IF $DATA(Q("DRR",Q6))
SET Q("DR",Q8-1)=Q6
+4 KILL Q("DRR")
+5 FOR Q("X")=0:0
SET Q("X")=$ORDER(Q("DR",Q("X")))
if Q("X")=""
QUIT
SET DR=Q("DR",Q("X"))
DO ED3
+6 KILL Q("SC"),Q("X"),Q("DR")
QUIT
ED SET DR=DR_"///"_Q8
DO ^DIE
DO SET
ED0 SET Q(1,Q)=Q("X")
SET DY=$PIECE(^TMP("SRCUSS",$JOB,Q("X"),0),U,1)-1
SET DX=1
XECUTE Q("XY")
WRITE !
DO A^SRCUSS
QUIT
ED1 ;S DY=+^(0)+1,DX=$P(^(0),U,2) X Q("XY"),^(2)
IF $ORDER(Q("DR",Q("X")))'=""
WRITE @IOF
XECUTE Q(0)
FOR Q6=0:0
SET Q6=$ORDER(^TMP("SRCUSS",$JOB,Q6))
if Q6=""!(Q6'=+Q6)
QUIT
if Q6>Q("X")
SET ^TMP("SRCUSS",$JOB,Q6,0)=$PIECE(^(Q6,0),U,1)+Q8
XECUTE ^TMP("SRCUSS",$JOB,Q6,1)
XECUTE ^(2)
ED2 SET DR=Q("DR",Q("X"))
SET DY=22
SET DX=1
XECUTE Q("XY")
WRITE Q("EPE")
DO ^DIE
WRITE $CHAR(13),Q("EOL")
SET Q("SC")="?"
WRITE @IOF,Q("EPE")
XECUTE Q(0)
+1 WRITE !
FOR Q8=1:1:^TMP("SRCUSS",$JOB,0)
IF $DATA(^TMP("SRCUSS",$JOB,Q8,1))
XECUTE ^(1)
SET DY=+^(0)+1
SET DX=$PIECE(^(0),U,2)
XECUTE Q("XY")
XECUTE ^(2)
+2 GOTO ED0
ED3 IF $DATA(^TMP("SRCUSS",$JOB,Q("X"),1))
XECUTE ^(1)
+1 IF '$TEST
QUIT
+2 IF ^TMP("SRCUSS",$JOB,Q("X"),2)["(WORD PROCESSING)"
DO ED2
QUIT
+3 SET @("DX(3)="_Q("BC"))
SET DX(3)=$ASCII(DX(3))
SET DX(1)=$X
SET DY(1)=$Y
SET DX=1
SET DY=22
XECUTE Q("XY")
+4 WRITE Q("EPE"),Q("HI"),"""."" WILL ENTER THE CHARACTER UNDERNEATH, SPACE BAR ENTERS THE NEXT WORD",!," ENTER A ""E"" TO ENTER NEW TEXT AT CURSOR, RETURN TO EXIT",Q("LO")
SET DX=DX(1)
SET DY=DY(1)
XECUTE Q("XY")
+5 SET (DX(0),DX(1))=$PIECE(^TMP("SRCUSS",$JOB,Q("X"),0),U,2)
SET (DY(0),DY(1))=+^(0)+1
SET Q6=$PIECE($PIECE(^(2),$CHAR(34)_",Q(""LO""),",1),"Q(""HI""),"_$CHAR(34),2)
SET Q("T")=0
WRITE Q("REV"),Q("HI")
+6 SET Q8=""
WRITE !
DO RDP
DO RD
if '$TEST
QUIT
SET DX=DX(0)-1
SET DY=DY(0)
XECUTE Q("XY")
WRITE Q("EOL"),Q("NOR"),Q("HI")
KILL Q("SC")
if "?@"[$EXTRACT(Q8,1)&(Q8'="")
DO ED2
IF '$DATA(Q("SC"))
DO ED
+7 QUIT
RD READ Q7:DTIME
if '$TEST
QUIT
SET Q7=$ASCII(Q7)
if ((Q7=13)&('Q("T")))
QUIT
+1 IF Q8=""
IF ((Q7=63)!(Q7=64))
SET Q8=$CHAR(Q7)
QUIT
+2 IF Q7=DX(3)
IF $LENGTH(Q8)>0
SET Q8=$EXTRACT(Q8,1,$LENGTH(Q8)-1)
SET DX(1)=$X
DO RDO
GOTO RD
+3 IF Q7=DX(3)
SET DX=$X+1
SET DY=$Y
if DX=81
SET DX=1
SET DY=DY+1
XECUTE Q("XY")
GOTO RD
+4 IF 'Q("T")
IF Q7=69
SET Q("T")=1
SET DX(2)=$EXTRACT(Q6,$LENGTH(Q8)+1,999)
SET DY(2)=$LENGTH(Q8)
SET DX(1)=$X-1
DO RDO
GOTO RD
+5 IF 'Q("T")
IF '((Q7=46)!(Q7=127)!(Q7=32))
SET DX(1)=$X-1
DO RDO
GOTO RD
+6 IF Q("T")=1
IF Q7=13
SET Q("T")=0
SET DX(2)=""
SET DX(1)=$X
DO RDO
GOTO RD
+7 IF Q7=127
IF 'Q("T")
SET Q6=$EXTRACT(Q6,1,$LENGTH(Q8))_$EXTRACT(Q6,$LENGTH(Q8)+2,999)
SET DX=$X-1
DO RDO
GOTO RD
+8 IF Q7=127
if $LENGTH(Q8)=DY(2)
GOTO RD
SET Q6=$EXTRACT(Q6,1,$LENGTH(Q8)-1)_$EXTRACT(Q6,$LENGTH(Q8)+1,999)
SET Q8=$EXTRACT(Q8,1,$LENGTH(Q8)-1)
SET DX(1)=$X-1
DO RDO
GOTO RD
+9 IF 'Q("T")
IF (Q7=46)
if $EXTRACT(Q6,$LENGTH(Q8)+1)=""
QUIT
SET Q8=Q8_$EXTRACT(Q6,$LENGTH(Q8)+1)
SET DX(1)=$X
SET DY(1)=$Y
DO RDP
GOTO RD
+10 IF 'Q("T")
IF Q7=32
SET DX(1)=$X
SET DY(1)=$Y
SET DY(3)=$FIND(Q6," ",$LENGTH(Q8)+2)
if DY(3)=0
SET DY(3)=$LENGTH(Q6)+1
SET DX(1)=DX(0)+DY(3)-1
SET Q8=Q8_$EXTRACT(Q6,$LENGTH(Q8)+1,DY(3)-1)
if DX(1)>80
SET DY(1)=DY(1)+DX(1)\80
SET DX(1)=DX(1)#80
DO RDO
GOTO RD
+11 SET Q8=Q8_$CHAR(Q7)
SET Q6=Q8_DX(2)
SET DX(1)=$X
SET DY(1)=$Y
DO RDP
GOTO RD
RDO SET DY(1)=$Y
if DX(1)=0
SET DX(1)=80
SET DY(1)=DY(1)-1
RDP if '$DATA(Q7)
SET Q7=0
SET DX=DX(0)
SET DY=DY(0)
XECUTE Q("XY")
WRITE Q6_$SELECT(Q7=127:" ",1:"")
SET DX=DX(1)
SET DY=DY(1)
XECUTE Q("XY")
QUIT
SET FOR Q8=1:1:Q
SET DA(Q8)=Q(9,Q)
+1 QUIT
