source: FOIAVistA/trunk/r/SURGERY-SR/SRCUSS2.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1SRCUSS2 ;TAMPA/CFB - SCREEN SERVER ; 9 Dec 1988 11:07 AM
2 ;;3.0; Surgery ;;24 Jun 93
3 K Q("DRR") F Q8=1:1 S Q6=$P(DR,";",Q8) Q:Q6="" S Q("DRR",Q6)=""
4 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
5 K Q("DRR")
6 F Q("X")=0:0 S Q("X")=$O(Q("DR",Q("X"))) Q:Q("X")="" S DR=Q("DR",Q("X")) D ED3
7 K Q("SC"),Q("X"),Q("DR") Q
8ED S DR=DR_"///"_Q8 D ^DIE,SET
9ED0 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
10ED1 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)
11ED2 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)
12 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)
13 G ED0
14ED3 I $D(^TMP("SRCUSS",$J,Q("X"),1)) X ^(1)
15 E Q
16 I ^TMP("SRCUSS",$J,Q("X"),2)["(WORD PROCESSING)" D ED2 Q
17 S @("DX(3)="_Q("BC")),DX(3)=$A(DX(3)),DX(1)=$X,DY(1)=$Y,DX=1,DY=22 X Q("XY")
18 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")
19 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")
20 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
21 Q
22RD R Q7:DTIME Q:'$T S Q7=$A(Q7) Q:((Q7=13)&('Q("T")))
23 I Q8="",((Q7=63)!(Q7=64)) S Q8=$C(Q7) Q
24 I Q7=DX(3),$L(Q8)>0 S Q8=$E(Q8,1,$L(Q8)-1),DX(1)=$X D RDO G RD
25 I Q7=DX(3) S DX=$X+1,DY=$Y S:DX=81 DX=1,DY=DY+1 X Q("XY") G RD
26 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
27 I 'Q("T"),'((Q7=46)!(Q7=127)!(Q7=32)) S DX(1)=$X-1 D RDO G RD
28 I Q("T")=1,Q7=13 S Q("T")=0,DX(2)="" S DX(1)=$X D RDO G RD
29 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
30 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
31 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
32 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
33 S Q8=Q8_$C(Q7),Q6=Q8_DX(2) S DX(1)=$X,DY(1)=$Y D RDP G RD
34RDO S DY(1)=$Y S:DX(1)=0 DX(1)=80,DY(1)=DY(1)-1
35RDP 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
36SET F Q8=1:1:Q S DA(Q8)=Q(9,Q)
37 Q
Note: See TracBrowser for help on using the repository browser.