TKFAXC ;PG&A,TK-FAX,2.10,QUEUE CONTROL;13MAR95 10:50A [ 11/17/2000   5:55 PM ]
 ;Copyright (C) 1993, Patterson, Gray and Associates Inc.
 ;
 I $D(^TKFAXC("CONDITION"))  X ^("CONDITION") E  H
 S A=^TK("ERROR")_"=""ERR^TKFAXC""",@A
 C:^TK("OS")="PSM" 0 B 0 H:$D(^TKFAXQ(.9))<10  S PTR=$P(^TKFAXC("CONFIG"),"\",12,13),BJBS=$P(^("CONFIG"),"\",14) S:BJBS<1 BJBS=1
 F SLV=0:1:BJBS H:SLV=BJBS  L TKFAX(SLV):0 I  Q
 B 1
A D TDATE^TKFAXU S RTY=$P(^TKFAXC("DEFLTS"),"\",7),FAX="" S:RTY<1 RTY=1
PR0 S PRIO=0,JOB="",NS=0,NC=1 K SCH H 2
 ;
CONTROL S JOB=$O(^TKFAXQ(.9,JOB)) I JOB="" G SEND:$D(PHN)>10 H 1 S PRIO=PRIO+1,NC=5 G CONTROL:PRIO<3,HALT
 S B=^TKFAXQ("DIR",1000000-JOB),C=+$P(B,"\",10),P=$E(1011,+$P(B,"\",14)) G CONTROL:P>PRIO
 I C=1 L +TKFAX("COMPILE"):0 G CONTROL:'$T,HUFF:NS<NC L -TKFAX("COMPILE") G PR0
 G:NS<NC SENDQ:C=2,SCHED:C=4 G SEND:NS'<NC,CONTROL
SCHED S C=$P(B,"\",24),SCH=0 G:$P($H,",",2)\90+($H*1000)'>C CONTROL S $P(B,"\",10)=2 S:$P(B,"\",14)=4 $P(B,"\",14)="1,4" S ^TKFAXQ("DIR",1000000-JOB)=B
SENDQ G:$P(B,"\",30)>RTY ERROUT L +TKFAXD(JOB):0 E  G CONTROL
 S PHN=$TR($P(B,"\",4)," -,","") I PHN]"" S PHN(PHN,JOB)="",NS=NS+1 S:+$P(B,"\",14)'=4 PHN(PHN)=1
 G CONTROL
SEND S PHN="" D GETPORT I D<3 K PHN L TKFAX(SLV):0 S NS=0 H 4 G CONTROL
SEND1 S PHN=$O(PHN(PHN)) I PHN="" K PHN C FAX L TKFAX(SLV):0 G PR0
 I $D(PHN(PHN))#2=0 D SEND3 E  K PHN(PHN) G SEND1
 S (K,JB)="" F J=1:1 S K=$O(PHN(PHN,K)) Q:K=""  Q:$L(JB)>120  S B=^TKFAXQ("DIR",1000000-K) I $P(B,"\",10)=2 S JB=JB_K_",",$P(B,"\",27)=$P($H,",",2),$P(B,"\",3)="Dialing",$P(B,"\",23)=FAX,^(1000000-K)=B,^TKFAXQ(.9,K)=FAX
 K PHN(PHN) D:JB ^TKFAXD1
 I $D(SJB) S lc="abcdefghijklmnopqrstuvwxyz",uc="ABCDEFGHIJKLMNOPQRSTUVWXYZ",A="" F K=1:1 S A=$O(SJB(A)) Q:A=""  S B=^TKFAXQ("DIR",1000000-A) D:SJB(A) SEND2,PRINT
 K DAT,SJB,INIT,DEST,lc,uc G SEND1
SEND2 S INIT=$P(B,"\",11),DEST=$TR($P(B,"\",4)," -,","")
 F I=1:1:3 S T=$P("FAX,INIT,DEST",",",I) F J=1,2 S M=@T,M=$TR(M,lc,uc) S:M="" M="NA" S M=M_"-"_$P("#,Min.",",",J),$P(^(M),"+",MT)=$S($D(^TKFAXC("STATS",YR,T,M)):$P(^(M),"+",MT),1:0)+$S(J=1:1,1:$J(SJB(A)/60,0,1))
 S ^TKFAXC("STATS",0,DEST)=$P(B,"\",32)_" - "_$P(B,"\",13) Q
SEND3 S JOB="" F I=1:1 S JOB=$O(PHN(PHN,JOB)) Q:JOB=""  I $D(^TKFAXQ(.9,JOB)),$P($H,",",2)\90+($H*1000)>$P(^(JOB),"\",24) Q
 Q
HUFF S TKFAXD="^TKFAXQ(""SRC"",JOB)",NS=NS+1 I NS>1,BJBS>1 D START
 S TKFAXS="^TKFAXQ(""FX"","_JOB_")" S $P(B,"\",25)=$P($H,",",2),$P(B,"\",3)="Convert",^TKFAXQ("DIR",1000000-JOB)=B D ^TKFAXH K OVR L -TKFAX("COMPILE") G:'$D(^TKFAXQ(.9,JOB)) CONTROL
 S B=^TKFAXQ("DIR",1000000-JOB),$P(B,"\",26)=$P($H,",",2)-$P(B,"\",25),$P(B,"\",10)=$S(+$P(B,"\",14)=3:4,1:2),$P(B,"\",9)=PGN,$P(B,"\",29)=TFXL\16
 S $P(B,"\",3)=$S(+$P(B,"\",14)=3:"Delayed",+$P(B,"\",14)=4:"Economy",1:"Ready"),^TKFAXQ("DIR",1000000-JOB)=B S:NC=1 JOB="" G CONTROL
ERROUT S A=$P(B,"\",3) I A["NO-D"!(A["COM-ERR") S $P(B,"\",30)=0,^TKFAXQ("DIR",1000000-JOB)=B G CONTROL
 K ^TKFAXQ(.9,JOB) S $P(B,"\",10)=3,A=$P(B,"\",3),$P(B,"\",3)="Fail-"_$S(A["NO-A":"NOA",A["BUSY":"BSY",A["NO-D":"NOD",1:"OTH"),^TKFAXQ("DIR",1000000-JOB)=B,^TKFAXQ("ERR",1000000-JOB)="Retry Failed - "_A,A=JOB D PRINT G CONTROL
ERR I JOB K ^TKFAXQ(.9,JOB) S B=^TKFAXQ("DIR",1000000-JOB),$P(B,"\",10)=3,$P(B,"\",3)="ERROR",^(1000000-JOB)=B S:$ZE'["DBD" ^TKFAXQ("ERR",1000000-JOB)=$ZE
 E  S ^TKFAXQ("ERR",0)=$ZE
 K PHN S:'$D(TEST) A=^TK("ERROR")_"=""ERR^TKFAXC""",@A H 5 L TKFAX(SLV):0 G CONTROL
HALT G:$G(^TKFAXC("CLEANUP"))=+$H HALT1 L +TKFAX("COMPILE"):30 Q:'$T  S ^("CLEANUP")=+$H
 L  S CONFIG=^TKFAXC("CONFIG") S D=$H-$P(CONFIG,"\",8),A="" F J=1:1 S A=$O(^TKFAXQ("SRC",A)) Q:A=""  I ^(A)<D K ^(A)
 S D=$H-$P(CONFIG,"\",9),A="" F J=1:1 S A=$O(^TKFAXQ("FX",A)) Q:A=""  I $S($D(^(A))=10:1,1:^(A)<D) K ^(A)
 S D=$H-$P(CONFIG,"\",10),A="" F J=1:1 S A=$O(^TKFAXQ("ERR",A)) Q:A=""  I $S($D(^TKFAXQ("DIR",A))=0:1,$P(^(A),"\",28)<D:1,1:0) K ^TKFAXQ("ERR",A)
 S D=$H-$P(CONFIG,"\",11),A="" F J=1:1 S A=$O(^TKFAXQ("DIR",A)) Q:A=""  S B=$P(^(A),"\",28) K:B<D ^(A) I B-D>100 S A=A+20
HALT1 I $D(SCH) H 10 G PR0
 Q:'$D(^TKFAXC("LOOP"))  X ^("LOOP") I  H 10 G PR0
 Q
 ;
T S TEST=1,BJBS=1,SLV=0,PTR=0 G A
 ;
RESTART I $D(^TKFAXQ(.9))>1  L TKFAX(0):0 I  L  J ^TKFAXC
 Q
START F I=0:1:BJBS-1 I I'=SLV L +TKFAX(I):0 I  L -TKFAX(I) J ^TKFAXC Q
 Q
GETPORT S A=^TKFAXC("FAX"),$P(A,"\",25)="",D=0,B=1,FAXP="" Q:$D(^("SUSPEND"))  I $G(FAX)'="" F I=1:6:19 S K=$P(A,"\",I) I K]"",K=FAX S B=I+6 Q
 F I=B:6:19 I $P(A,"\",I)'="",$P(A,"\",I+1)'="Y" S K=$P(A,"\",I)  O K::5 I  S D=3,FAX=K,FAXP=$P(A,"\",I,I+5) Q
 ;s Status=$ZF(-1,"Mode COM"_(K-2)_": baud=57600 parity=e data=8 stop=1 dtr=on rts=hs")
 I D<3,$G(FAX)'="" S FAX="" G GETPORT
 I D<3 Q
 S FAXP=$P(FAXP,"\",4,6) S:$P(FAXP,"\")="" $P(FAXP,"\")="ATDT" S:$P(FAXP,"\",3)="" $P(FAXP,"\",3)="PG&A TK-FAX"
NOECHO I ^TK("OS")="DTM" U FAX:(xongen=1:xon=1:speed=19200:parity="NONE":stopbits=1:charbits=8:em=0:ixinterp=1) Q
 I ^TK("OS")="MSM" U FAX:(0::::2097152+262144+4096+1:16384+8:::$C(13,10)) Q
 I ^TK("OS")="M11" U FAX:(0:"SI":$C(13):" 0801C11":14400) Q
 ;I ^TK("OS")="DSM4" U FAX:(NOECHO,WIDTH=0,PASTHRU) Q
 U @(""""_FAX_""""_$P(^TK("WRAP-OFF"),"0",2,9)) U @(""""_FAX_""""_$P(^TK("ECHO-OFF"),"0",2,9)) Q
 Q
PRINT D:PTR'?.P ^TKFAXQP Q