TKFAXQ2 ;PG&A,TK-FAX,2.10,EDIT PHONEBOOK;14SEP91  21:55;22MAR93 10:05A [ 11/17/2000   5:55 PM ]
 ;Copyright (C) 1991-1994, Patterson, Gray and Associates Inc.
 ;
POP S Y=";16,13,38,PD;16,57,21,PDN;17,13,38,PD;20,15,1,PD1;21,15,1,PD1;20,27,1,PD1;21,27,1,PD1;20,47,1,PD3;21,47,1,PD2;20,62,1,PD2;21,62,1,PD3;20,72,1,PD4;21,72,1,PD5",TB=$C(2,1,0,3,2,1,0,5,4,3,2,1,0)
 S NE=$L(Y,";")-1,(OD,D)="",R=0 K X
 D REF
P4 F C=1:1:NE S D=$P(Y,";",C+1),%C=$P(D,",",2),LNG=$P(D,",",3),RD=$P(D,",",4),%R=+D,X=X(C),FNC="EX,HL,PD",RX=0 W @TKP D @RD S X(C)=X D:FNC["HL" HL S C=C+$S(FNC="EX":99,FNC="PD":99,RX=2:0,14[RX:-2,RX=3:$A(TB,C),1:0) S:C<0 C=0
 W TK("ROF") G:C>50 END S X=X(2)_"`"_X(1)_"`" F J=4:1:13 S X=X_X(J)_"`"
 S X=X_X(3),D=$TR(X(1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") K:D'=OD&$L(OD) ^TKFAXP(OD) S:D'="" ^TKFAXP(D)=X K K G POP
END K X,D,OD,K Q
PD X ^TKREAD S X=$TR(X,"\","") Q
PDZ D PDS X ^TKREAD I ESC S X=$S(RX=" ":" ",1:"*") W X I X="*" S:B1<11 RX=3 F CC=B1:1:B2 I C'=CC,X(CC)'="" S D=$P(Y,";",CC+1),%R=+D,%C=$P(D,",",2) W @TKP," " S X(CC)=""
 K B1,B2 Q
PD1 S B1=4,B2=7 D PDZ
 Q
PD2 D PDS X ^TKREAD I ESC S X=$S(RX=" ":" ",1:"*") W X
 Q
PD3 S CHR="YNPynp " X ^TKREAD I ESC S:X?1L X=$C($A(X)-32) W X
 Q
PD4 S CHR="ABCDabcd " X ^TKREAD I ESC S:X?1L X=$C($A(X)-32) W X
 Q
PD5 S CHR="479 " X ^TKREAD I ESC S:X?1L X=$C($A(X)-32) W X
 Q
PDS S TRM=" !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~" Q
 ;
PDN S CHR="0123456789,W -" X ^TKREAD Q
 ;
HL D HLP S C=C-1 G REF
HLP S D=X(1) D HLP1 Q:D[";EX"  I $L(D)>1 S OD=D,D=^TKFAXP(D)
 S X(1)=$P(D,"`",2),X(2)=$P(D,"`"),X(3)=$P(D,"`",13) F J=3:1:12 S X(J+1)=$P(D,"`",J)
 Q
HLP1 N (TK,TKP,BL,D) S D=$TR(D,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"),%R=BL-9,Y="4\DLHCS\1\PhoneBook\\",Y(0)="8\EX\^TKFAXP\$P(^(TO),$C(96),2);26`$P(^(TO),$C(96),13);25`$P(^(TO),$C(96));18R\"_D_"\\\"_D_"~" D ^TKFAXU2 S D=X Q
REF S %R=12,%C=2,B="",$P(B,TK("HL"),76)="" W @TKP,TK("LO"),TK("RON"),TK("L"),@TKP,TK("G1"),TK("TLC"),B,TK("TRC") F %R=%R+1:1:22 W @TKP,TK("G1"),TK("VL"),TK("G0"),$J("",75),TK("G1"),TK("VL"),TK("G0")
 S %R=%R+1 W @TKP,TK("G1"),TK("BLC"),B,TK("BRC"),TK("G0")
 S %C=10,%R=12 W @TKP,$P(Y,";") S TKs=1
 I '$D(^TKFAXC("SCR",TKs,0,TK,1)) S TKGLOB="^TKFAXC(""SCR"")",TKROUT="^TKFAXS1" D ^TKINTSCR
 W $P(^(1),"SUBJECT:",2,9) F I=2:1 Q:$D(^(I))=0  W ^(I)
 S %R=13,%C=4 W @TKP,TK("LO"),TK("RON"),"PHONEBOOK EDIT - Press HELP key for listings - make selection - Edit" S %R=14 W @TKP,"entry and press TAB to save, EXIT to not save, Clear & TAB to Delete"
 W TK("HI"),TK("ROF") F B=1:1:NE S D=$P(Y,";",B+1),%C=$P(D,",",2),LNG=$P(D,",",3),%R=+D W @TKP S:'$D(X(B)) X(B)="" W X(B),$J("",LNG-$L(X(B)))
 Q
T K X S BL=22 D POP Q