- 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 Feb 19, 2025@00:05:38 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
