cAN322(TIT,KEU,BR,KR0,NOMIN,%S3) ;Printerkeuze ;%AN322; [ 01/04/01  2:06 PM ]
 G 1
 ;
 ; Ingang :
 ;     TIT = titel : indien niet ingevuld : "Informatie"
 ;     KEU = mogelijkheden (niet ingevuld = alles)
 ;       vb : 1#3 = printer en fax
 ;     mogelijke keuzes (del #) : 1 = printer
 ;                                2 = scherm
 ;                                3 = fax
 ;                                4 = bestand
 ;                                9 = later printen
 ;     BR = breedte : niet ingevuld = 80
 ;     KR0 = 1 : keuze printer via R0-routine
 ;
 ;     %S3 = een Xecute die kan uitgevoerd worden : zie beheer vaste
 ;           printer
 ; 
 ; Uitgang :
 ;     PTS = "" = printer
 ;           1  = scherm
 ;           2  = fax
 ;           3  = bestand
 ;           .  = later printen (ook K=".")
 ;     %S99 en PTS(1) = intern nummer printer uit ^cPRINT
 ;     PTS(2) = aanduiding ivm DUMMY-printer
 ;     F70 en F71 : Xecute om te printen
 ;
T1 ;bestemmingen; karakters;
T2 ;Scherm;
T3 ;  Printer gestart, druk Ctrl-C om te stoppen ... ;
T4 ; is in gebruik ;
T5 ;Keuze printer;
T6 ;  Printer gestart, druk Ctrl-C om te stoppen ... ;
 ;
T1F ;destinations; caractères;
T2F ;L'écran;
T3F ;  Impression en cours, tapez 'Ctrl-C' pour interrompre ... ;
T4F ; n'est pas disponible ;
T5F ;Sélection de l'imprimante;
T6F ;  Impression en cours, tapez 'Ctrl-C' pour interrompre ... ;
 ;
T1E ;destination; characters;
T2E ;Screen;
T3E ;  Printer started, press Ctrl-C to interrupt ... ;
T4E ; is in use ;
T5E ;Selection of printer;
T6E ;  Printer started, press Ctrl-C to interrupt ... ;
 ;
 ; start
1 D MASTER^cQ5 S $ZT="TRAP^cAN000"
 N B,IPP,IPA,ZC,FLT,I,INIT,UREF,UQC,USC,UFLT
 D DMS^cAN000("UQC","USC","SYS.PRINT") G YZ:'$L(UQC)!'$L(USC)
 S UREF=^DMC(UQC,USC,"DATA","REF")
 S io=$G(io,$$IO^cQ5)
 S KEU=$G(KEU),BR=$G(BR,80),KR0=$G(KR0)
 S:'$L($G(TIT)) TIT=$P($T(@("T1"_QT)),U,2)
 I $L(BR),BR'=80 S TIT=TIT_" ("_BR_$P($T(@("T1"_QT)),U,3)_")"
 ; opbouw filter aan de hand van de mogelijkheden
 S FLT="" I $L(KEU) D
 . S K=$TR($TR(KEU,"123456789"," 12345678")," ","")
 . S FLT="I ""#"_K_"#""[(""#""_$P(^(0),D,9)_""#"")"
17 B 1
 K PTS
 I $G(KR0) S K=$$KR0(FLT) G 19
 S K=$$^cANSYN("SYS.PRINT","","",KEU[2!'$L(KEU),"","",FLT,TIT,$P($T(@("T2"_QT)),U,2))
19 W /WDSP
 B 0
 I K="-" G 17:$G(NOMIN),YZ
 ;
2 I KEU[2!'$L(KEU),'$L(K) D  G 17:'$L(K)  ; via TAB naar "Scherm"
 . N UI1
 . S UI1="" F  S UI1=$O(@UREF) Q:UI1=""  I $P(^(UI1,0),D,9,10)="1\80" S K=UI1 Q
 I '$L(K) G YZ
 I K S B(1)=$$SIGN^cAFA1("SYS.PRINT",K,0)
21 S (%S99,PTS(1))=K,E=0,FAX=0
 ; driver + bladspiegel
 S %S1=$P(B(1),D,4),%LNMAX=$P(B(1),D,5),PTS=$P(B(1),D,9),INIT=1
 I $L($P(B(1),D,13)) G 4 ; locale printer
 ;
 ; centrale printers
 ; poortnr.
3 S K=$P(B(1),D,3)
 ; dummy printer
 I K="$P" D  G 5
 . S PTS(2)=1
 . S F70="W:$L($G(F11))&$L($G(F1)) @F11,@F1 W !! D ^cA611,X^cA612 S LNMAX=50,FAX=0,F71=""W !!! H 2 D ^cA606,W^cA612,E^cAN322 K FAX"""
 . S INIT=0
 ; printers
31 I $P(B(1),D,9)="" D  G 17:E,5
 . ; Mumps-printer
310 . I $P(B(1),D,6)=1 D  Q
 .. ; indien Caché
 .. I $ZV'["MSM" D  Q
 ... S K=$TR(K,"/","\")
 ... O "|PRN|"_K::2 E  D E1 Q
 ... C "|PRN|"_K
 ... S F70="O ""|PRN|"_K_""" U ""|PRN|"_K_""":0",F71="H 1 C ""|PRN|"_K_""""
 .. ; Indien MSM
 .. O K::2 E  D E1 Q
 .. C K
 .. S F70="O "_K_" U "_K_":0",F71="C "_K
 . ; Lat-printer
312 . I $P(B(1),D,6)=2 D  Q
 .. O K::2 E  D E1 Q
 .. C K
 .. S F70="O "_K_" U "_K_":0",F71="H 2 C "_K
 . ; LPD-printing
314 . I $P(B(1),D,6)=3 D  U 0 Q
 .. S IPA=$P(B(1),D,7),IPP=$P(B(1),D,8)
 .. ; indien Caché
 .. I $ZV'["MSM" D  Q
 ... C "|TCP|4" O "|TCP|4":(IPA:IPP):1 E  D E1 Q
 ... U "|TCP|4" S ZC=$ZA I ZC=2!(ZC=4)!(ZC=256) C "|TCP|4" U $P D E1 Q
 ... C "|TCP|4"
 ... S F70="O ""|TCP|4"":("""_IPA_""":"_IPP_":""CS"") U ""|TCP|4""",F71="H 1 C ""|TCP|4"""
 .. ; Indien MSM
 .. C 56 O 56::2 E  D E1 Q
 .. U 56:(:1+32):"TCP" W /SOCKET(IPA,IPP) S ZC=$ZC I ZC C 56 U $P D E1 Q
 .. C 56
 .. S F70="C 56 O 56 U 56:(:1+32):""TCP"" W /SOCKET("""_IPA_""","""_IPP_""")",F71="H 1 C 56"
 ; schermen
33 I $P(B(1),D,9)=1 D  G 17:E,5
 . S F70="D ^cA611,B^cA612:$G(QW) W:$G(QW) /WWR(1) S F71=""D ^cA606,C^cA612:$G(QW),E^cAN322"""
 ; faxen
35 I $P(B(1),D,9)=2 D  G 17:E,59
 . N %S3
 . I $$SIG^cAFA1("SYS.SCR",K,101)'="AA" S E=1 Q
 . S FAX=K D ^cA3220 I K="-" S E=1 Q
 . S F70="D B^cAN322(6) "_F70,F71=F71_" D E^cAN322"
 ; bestanden
37 I $P(B(1),D,9)=3 D  G 17:E,5
 . S F70="",F71="D E^cAN322"
 . D PRINT^cA701 I K="-" S E=1 Q
39 ; later printen
 I $P(B(1),D,9)=8 S (PTS,K)="." G YZ
 G 5
 ;
 ; printers aan het scherm
 ; driver scherm
4 S %S2=$$SIG^cAFA1("SYS.SCR",$P(B(1),D,3),101) I $ZV'["MSM" S %S2="ZC"
 S F70="F70",F71="F71"
 ; aansluiting
 S K=$P(B(1),D,13)-1 I K<1 S K=""
 S F70=F70_K,F71=F71_K
49 S F70=$$SIGN^cAFA1("DEV.VID",%S2,F70),F71=^(F71)
 ;
5 ; aanvullen F70 en F71
 S K=$P(B(1),D,24) I $L(K) S F70=F70_" "_K
 I %LNMAX S F70=F70_" S %LNMAX="_%LNMAX
 K %LNMAX
 S F70=F70_" S %S1="_$S($D(%S3):""""_%S1_"""",1:%S99) I 'PTS,INIT S F70=F70_" D ^cA605"
 S F71=F71
 I 'PTS,INIT S F70="D B^cAN322(3) "_F70_" D BE^cAN322",F71=F71_" D E^cAN322"
59 I $L($G(%S3)) X %S3
 ;
YZ K %S1,%S2 Q
 ;
B(T) ; Begin printen
 B 0
 I '$G(T) S T=3
 I '$G(QW) S FP=2201+F60 W @F,@F1,$P($T(@("T"_T_QT)),U,2)
 I $G(QW) D
 . I $ZV["MSM" D
 .. D X^cA612 W /CUP(22,1),@F1,$P($T(@("T"_T_QT)),U,2)
 .. I QP,F71'[" D W^cA612" S F71=F71_" W /CUP(22,1),/ED(0) D W^cA612 S F71=$P(F71,"" D W^cA612"")"
 . I $ZV'["MSM" D
 .. D O^cA612(22,1,3,80,0,0,0,0) W /CUP(1,1),@F1,$P($T(@("T"_T_QT)),U,2)
 .. I QP,F71'[" D C^cA612" S F71=F71_" D C^cA612 S F71=$P(F71,"" D C^cA612"")"
 B 1
 Q
 ;
BE I $L($G(^cLOG(boot,"TERMINAL",$I))) X ^($I)
BEZ Q
 ;
E ; einde printen
 D ^cA606
 I $G(QP) S F70="D ^cA322",F71="D:'$D(F) ^cA606" K PTS(2)
 B 0
 Q
 ;
E1 S K=$P(B(1),D)_"-"_$P(B(1),D,$G(QTU,1)*10-8)_$P($T(@("T4"_QT)),U,2) D F1
 S E=1
 Q
 ;
F1 N R S R=250
F2 D TXT^cAFA1(R)
FZ K R Q
 ;
KR0(FLT) ;
 N UQC,USC,UREF,UI1,B,S1,C,I1,I,L,RR
 S K="-",FLT=$G(FLT)
 D DMS^cAN000("UQC","USC","SYS.PRINT") I '$L(UQC)!'$L(USC) G KR0Z
 S IREF=^DMC(UQC,USC,"DATA","INDEX")
 S I1="" K L
 F  S I1=$O(@IREF@(101,I1)) Q:I1=""  D
 . S UI1=^(I1),B(1)=$$SIGN^cAFA1("SYS.PRINT",UI1,0)
 . I $P(B(1),D,30) Q
 . S S1=1 I $L(FLT) X FLT S S1=$T
 . I 'S1 Q
 . S RR($P(B(1),D))=UI1_D_$P(B(1),D,QTU*10-8)
 . I $P(B(1),D,13) S L(1)=$G(L(1))_$P(B(1),D)_D
 . E  S L(2)=$G(L(2))_$P(B(1),D)_D
 S (I,C)=""
 F i=1,2 F  Q:'$L($G(L(i)))  D
 . N K
 . S K=$P(L(i),D)_"[] = "_$P(RR($P(L(i),D)),D,2)
 . I (I>0*2+I+$L(K))>78 S C=C_""",!?2,""",I=0
 . S C=C_$S(I>0:"  ",1:"")_K,I=I>0*2+I+$L(K)
 . S L(i)=$P(L(i),D,2,$L(L(i),D))
 S R="K\22\3\"_$P($T(@("T5"_QT)),U,2)_"\"""_C_"""\6\\$S(K=""-"":1,'$L(K):0,1:$D(RR(K)))",$P(R,D,11)=1 D R0
 I K="-" G KR0Z
 S K=$P(RR(K),D)
KR0Z Q K
 ;
R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
 ;
ZZ ; 05.02.01 - 16 u 23 * V7.84