SRCUSS0 ;TAMPA/CFB - SCREEN SERVER ; [ 03/11/02 13:37 PM ] ;;3.0; Surgery ;**66,108,118,130**;24 Jun 93 CO S Q(12,1)=$P(Q(2),":",1),Q(12,2)=$P(Q(2),":",2),Q(12,0)="",Q(12,8)=0 F Q(12,7)=+Q(12,1):0:+Q(12,2) D COM Q:Q(12,8)!(Q(12,7)>+Q(12,2)) I $L(Q(12,0))+$L(Q0(Q,0))>100 D COM1 Q S Q(2)=Q(12,1),Q0(Q,0)=Q(12,1)_";"_Q(12,0)_Q(12,2)_";"_Q0(Q,0) Q COM S Q(12,7)=$O(@("^DD("_+Q(0,Q)_","_Q(12,7)_")")) S:Q(12,7)'?1NP.NP!(Q(12,7)="")!(Q(12,7)'14 W Q("HI") S DIC=Q(8,Q),DIC(0)="QAEM" K DIC("V") D ^DIC G MP M0 I Q("LIMIT")>19,Q("1",Q)>16 D CONT G:+Q(1)>0 M11A I Q(1)="^" S Q(13)=1 K Q(11),Q(13,0) G M11 K Q(13,0) G:Q(10,Q)'=+Q(10,Q) MQ1 S (DA(Q),Q(7,Q(1,Q)),Q(9,Q),Q(10,Q))=$O(@(Q(8,Q)_Q(10,Q)_")")) G:Q(10,Q)'=+Q(10,Q)!(Q(10,Q)<1) M1 D A^SRCUSS S Q4(-4,Q(1,Q)-1)=Q(7) I Q(13)#Q("LIMIT") G M0 M1 W !,Q(1,Q),?5,"NEW ENTRY" S Q(7,Q(1,Q))=$S(Q(1,Q)=1:1,1:Q(7,Q(1,Q)-1)+1),Q(13)=1 K Q(11),Q(13,0) S:$P(Q(3),"^",5,99)["D IX^DIC" Q("S",Q,"IX")=$P(Q(3),"^",5,99) M11 K QPQPQ W Q("HI") W !!,"Enter Screen Server Function: " R Q(1):DTIME S:'$T Q(1)="" S:Q(1)=0 Q(1)="?" S:Q(1)="a" Q(1)="A" I Q("LIMIT")=19,Q(1)>15 S Q(1)="?" M11A S:Q(1)?.E1C.E Q(1)="?" I Q(1)["?"!(Q(1)?2.99A) D QUES^SRCUSS5 G MQ S:$S(Q(1)="^^":1,$E(Q(1))'="L":0,+$E(Q(1),2,99)0,$E(Q(1),$L(Q(1)))="R",+Q(1)Q(1,Q)),M0:Q(1)="" S (DA(Q),Q(9,Q))=Q(7,Q(1)),Q(13)=1 M110 I '$D(Q3("VIEW")),(+Q(1)=Q(1,Q)!(Q(1)["R")) S:Q(1)=1 @("Q(3)=^DD("_+$P(Q(3),U,2)_",.01,0)") S DIC=Q(8,Q),DIC(0)="ZMEL"_$S(Q(1)'["R":"QA",1:""),DIC("DR")=.01 S Q(1)=+Q(1) I $T S:$D(Q("S",Q,"MUL")) DIC("S")=Q("S",Q,"MUL") I $T S:$D(Q4(-4,Q(1))) X=$C(34)_Q4(-4,Q(1))_$C(34) K DIC("V") D SET,^DIC K DIC("S") G MQ:+Y<1 G SET2 M111 ; I $D(Q3("VIEW")),Q(1)=Q(1,Q) G MQ S Q3(Q)=$E(Q3(Q)_" ("_Q4(-4,Q(1)),1,60)_")" K Q4 M12 I $D(Q(14)) K Q(10) S (Q(1,Q),Q(13),Q0(0,Q))=1 X Q(0) D TEMC^SRCUSS4,A^SRCUSS:'(+$P(Q0(Q,1),";",2)'=".01"&($P(Q0(Q,1),";",3)="")) G MQ I $E(Q(12,5),1,2)="DR",$D(DR(Q,+Q(0,Q)))#2 K Q(10) S Q7="DR("_Q_","_+Q(0,Q)_")",(Q(1,Q),Q(13),Q0(0,Q))=1 X Q(0) D PAGE^SRCUSS4,A^SRCUSS:'($P(Q0(Q,1),";",2)=".01"&($P(Q0(Q,1),";",3)="")) G MQ S (Q("P",Q),Q8,Q6)=1,Q0(Q,0)=".01:999999999" D PA1^SRCUSS4 M2 K Q(10,Q) S (Q(1,Q),Q(13))=1 X Q(0) D A^SRCUSS K Q(1,Q) S Q=Q-1,Q(1,Q)=1 S Q(1)="Q",Q(3)=Q(2,Q,Q2(Q,1)) G M MQ W:Q("ED") Q("HI") K Q8(2),Q(10,Q),Q0(Q),Q("S",Q) S Q=Q-1,Q(1)="Q",Q(13)=1,Q(3)=Q(2,Q,Q2(Q,1)),Q(0,Q+1)=$P(Q(3),U,2) G M MQ1 W:Q("ED") Q("HI") K Q8(2),Q(10,Q),Q0(Q),Q("S",Q) S Q=Q-1,Q(1)="Q",Q(13)=1,Q(12,12)="" Q MP X Q(0) S Q(1,Q)=1 G M1:Y<1 S (DA(Q),Q(7,Q(1,Q)),Q(9,Q),Q(10,Q))=+Y D A^SRCUSS S Q4(-4,Q(1,Q)-1)=Q(7) G M1 SET S QQ=$S(Q>1:Q-1,1:1) F Q8=1:1:QQ S QQQ=$S(Q>1:Q-Q8,1:1),DA(Q8)=Q(9,QQQ) Q SET2 I Q(5)="P"&(Q(7,Q(1))'=+Y) D G M11A:'$D(Y) .S Q(999)=0 .F S Q(999)=$O(Q(7,Q(999))) Q:'Q(999) D ..S PSDPTR=Q(7,Q(999)) ..S:PSDPTR=+Y Q(1)=Q(999),Q(999)=99 .K Y,Q(999),PSDPTR S @("Q(9,Q)=$P("_DIC_"0),U,3)"),Q4(-4,Q(1))=+Y(0),Q(7)=Q4(-4,Q(1)),Q("BP")="" D:$P(Q(3),U,2)["P" P^SRCUSS S Q4(-4,Q(1))=Q(7) K Q("BP") G M110:Q8(2) G M111 Q CONT ; S:Q("LINE")>15 Q("LINE")=0 I Q("LINE")=0 W !!,"Press to see more, '^' to exit this list, OR",!,"CHOOSE 1-",Q("1",Q)-1,": " R Q(1):DTIME S:'$T Q(1)="" S:+Q(1)'>0&(Q(1)'="^") Q(1)="" S Q("LINE")=Q("LINE")+1 S:Q(1)>(Q("1",Q)-1) Q(1)="" Q