BLBERI ;BLUM BERICHTEN RAADPLEGEN ;BLBERI; Do naar PROC [ 03/05/2002  10:18 AM ]
 G BEGIN
 ;
T1 ; Identif  | Type   | Verzonden       | Dat ontv | Te bev | Bev    | #Rec
T2 ;;C;R;1;;\2;C;L;8;; |\3;C;R;4;;-\4;C;L;2;; |\5;C;R;9;;  \6;C;R;5;; |\7;C;R;9;; | \8;C;L;6;; | \$P("Neen"_D_"Ja",D,$P(FL(3),D,10)+1-(2*($P(FL(3),D,8)="Neen")));C;L;6;; |\9;N;R;6;;
T3 ; Identif  | Type   | Verzonden       | Dat ontv | Te bev | Bev    | #Rec
T4 ;;C;R;1;;\2;C;L;8;; |\3;C;R;4;;-\4;C;L;2;; |\5;C;R;9;;  \6;C;R;5;; |\7;C;R;9;; | \8;C;L;6;; | \$P("Neen"_D_"Ja",D,($F("TB",$P(FL(3),D,1))-1-(2*($P(FL(3),D,1)="B"&($P(FL(3),D,8)="Neen")))));C;L;6;; |\9;N;R;6;;
T5 ;  Toelnr |    Datum | Referentie
T6 ;1;N;R;9;;| \2;C;L;8;; | \3;C;L;25;;
T7 ;BLUM RAADPL BERI;OVERZICHT
T10 ; Geen verstuurde berichten 
T11 ; Geen ontvangen berichten 
T12 ;VERSTUURDE;ONTVANGEN;TOELEVERINGEN
T13 ;*** I'm thinking ***
T14 ;VERWIJDEREN
T15 ;V = verwijderen   - = annuleer
T16 ;TOT WANNEER DE BERICHTEN VERWIJDEREN
T17 ;3 = 3 maand   H = 1/2 jaar   1 = 1 jaar   2 = 2 jaar
T18 ;Neen;Ja
T19 ;Berichtbevestiging herzenden
T20 ;H = Herbevestigen   - = annuleer
 ;
O1 S K=$P($T(T10),U,2) G OY
O2 S K=$P($T(T11),U,2) G OY
OY S FP=2403 W @F,@F1,@FMTI,K,@FMTi,@F0
OZ Q
 ;
 ; Schermaanduiding
SA S FP=255 W @F,@FMTB,$J($P($T(T12),U,$F("SRT",U4)),25),@FMTb
 Q
 ;
SA1 S FP=255 W @F,$J("",5),@FMTK,$P($T(T13),U,2),@FMTk
 Q
 ;
 ; Initialisatie
IN S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
 S SND(1)="^HULP($J,""SND"",",SND(2)=$P($T(T2),U,2,999),SND(3)=5,SND(6)=1,SND(8)=$P($T(T1),U,2)
 S REC(1)="^HULP($J,""REC"",",REC(2)=$P($T(T4),U,2,999),REC(3)=5,REC(6)=1,REC(8)=$P($T(T3),U,2)
 S STO(1)="^HULP($J,""STO"",SND,",STO(2)=$P($T(T6),U,2,999),STO(3)=16,STO(8)=$P($T(T5),U,2)
 S R="S",VTB="" K ^HULP($J)
 Q
 ;
 ; Help
HLP D SA
 S HLP(1)=$P($T(T7),U,2),HLP(2)=$P($T(T7),U,3),HLP(3)=5,HLP(6)="" D HLP^HELP
 Q
 ;
 ; Bevestiging + uur
BU2 I $E($P(U2,D,4),4)'="u" S $P(U2,D,4)=$E($P(U2,D,4),1,2)_":"_$E($P(U2,D,4),3,4)
 I $E($P(U2,D,4),4)="u" S $P(U2,D,4)=$E($P(U2,D,4),1,2)_":"_$E($P(U2,D,4),6,7)
 S $P(U2,D,6)=$P($T(T18),U,$P(U2,D,6)+2)
 Q
 ;
 ; Verzonden berichten
SND S DL(1)="SND",SND(4)=20 G SND3:VTB=U4 D SA G SND2:$D(^HULP($J,"SND")) S VNR=100000,SND=-1 D SA1
SND1 S SND=$N(^BLBeri("O",SND)) I SND'=-1 S VNR=VNR-1,U2=^(SND) D BU2 S ^HULP($J,"SND",VNR_SND)="O"_D_SND_D_U2 G SND1
 D RL^PROC1
SND2 D SA,WL^PROC I '$D(^HULP($J,"SND")) D O1
SND3 D SL^PROC S VTB=U4
 Q
 ;
 ; Ontvangen berichten
REC S DL(1)="REC" G REC4:VTB=U4 D SA G REC3:$D(^HULP($J,"REC")) S VNR=100000,REC=-1 D SA1
REC1 S REC=$N(^BLBeri("B",REC)) I REC'=-1 S VNR=VNR-1,U2=^(REC) D BU2 S ^HULP($J,"REC",VNR_REC)="B"_D_REC_D_U2 G REC1
REC2 S REC=$N(^BLBeri("T",REC)) I REC'=-1 S VNR=VNR-1,U2=^(REC) D BU2 S ^HULP($J,"REC",VNR_REC)="T"_D_REC_D_U2 G REC2
 D RL^PROC1
REC3 D SA,WL^PROC I '$D(^HULP($J,"REC")) D O2
REC4 D SL^PROC S VTB=U4
 Q
 ;
 ; Verwijderen berichten
VRW I '$D(^HULP($J,DL(1),@(DL(1)_"(6)"))) S R="" G VRW3
 S FL(1)=@(DL(1)_"(2)"),FL(2)=2301,FL(3)=^(@(DL(1)_"(6)"))
 S FP=2101 W @F,@F1,!?2,$P($T(T14),U,2) D FL^PROC W !?2,$P($T(T15),U,2)
VRW1 D IK^PROC1
 I R'="V" S U4=R,DL(2)=21,DL(3)=24 D WL^PROC S R=U4 G VRW3
 G VRW2:$D(^HULP($J,DL(1),@(DL(1)_"(6)")+1))
 S @(DL(1)_"(6)")=@(DL(1)_"(6)")-1 I '@(DL(1)_"(6)") S @(DL(1)_"(6)")=1
VRW2 K ^BLBeri($P(FL(3),D,1),$P(FL(3),D,2)),^HULP($J,DL(1)) S R=VTB,VTB=""
VRW3 Q
 ;
 ; Clean up
CLN S FP=2201 W @F,@F1,!?2,$P($T(T16),U,2),!?2,$P($T(T17),U,2)
CLN1 K IK D IK^PROC1 I "H123"'[R S U4=R S DL(2)=22,DL(3)=24 D WL^PROC S R=U4 G CLN3
 S EDT=$$CALCDATE^vhDTyp($H,"M",-$S(R=3:3,R="H":6,1:R*12))
CLN2 ;
 S KIL=0,BOT="O" D CLN4 S BOT="B" D CLN4 I KIL S R=VTB,VTB="" K ^HULP($J,"REC"),^("SND") G CLN3
 S DL(2)=22,DL(3)=24 D WL^PROC S R=VTB
CLN3 Q
 ;
CLN4 S BID=$N(^BLBeri(BOT,-1)),BID=-1
CLN5 S BID=$N(^(BID)) G CLN6:BID=-1
 S TDT=$P(^(BID),D,3),TDT=$$INTDATE^vhDTyp(TDT)
 I TDT<EDT K ^BLBeri(BOT,BID) S KIL=1
 G CLN5
CLN6 Q
 
 ; Herzenden van berichtbevestiging
RESEND IF '$D(^HULP($J,DL(1),@(DL(1)_"(6)"))) S R="" Quit
 S FL(1)=@(DL(1)_"(2)"),FL(2)=2301,FL(3)=^(@(DL(1)_"(6)"))
 Quit:$P(FL(3),D,1)="T"  ; Nog te bevestigen
 Quit:$P(FL(3),D,1)="O"  ; Verstuurde berichten
 S FP=2101 W @F,@F1,!?2,$P($T(T19),U,2) D FL^PROC W !?2,$P($T(T20),U,2)
 D IK^PROC1
 If R'="H" S U4=R,DL(2)=21,DL(3)=24 D WL^PROC S R=U4 Quit
 S ^BLBeri("T",$P(FL(3),D,2))=^BLBeri("B",$P(FL(3),D,2))
 K ^BLBeri("B",$P(FL(3),D,2))
 S $P(FL(3),D,1)="T"
 S $P(^HULP($J,DL(1),@(DL(1)_"(6)")),D,1)="T"
 S R=VTB,VTB=""
 Q
 
 ;
 ; Overzicht toeleveringen
STO I VTB'="S"!'$D(^HULP($J,"SND")) S R=VTB G STO4
 S SND=SND(6) I $P(^("SND",SND),D,3)'="COM" S R=VTB G STO4
 D SA S IDF=$P(^(SND),D,2) G STO2:$D(^HULP($J,"STO",SND)) S (VNR,TR)=0 D SA1
STO1 S TR=$N(^BLBeri("O",IDF,TR)) G STO2:TR=-1
 S (DAT,REF)="" I $D(^KTO1(TR)) S DAT=$P(^KTO($P(^(TR),D,1),TR,1),D,2),REF=$P(^(1),D,3)
 S VNR=VNR+1,^HULP($J,"STO",SND,VNR)=TR_D_DAT_D_REF G STO1
STO2 S DL(2)=SND(3),DL(3)=10 D PL^PROC
 K DL S DL(1)="STO",STO(9)=VNR D SA,WL^PROC
STO3 D SL^PROC G STO3:R="T"
 I $L(R),"SV"[R K DL S DL(1)="SND",DL(2)=SND(3),DL(3)=20,U4="S" D SA,PL^PROC K DL(2),DL(3)
STO4 Q
 ;
BEGIN D IN G 1
 ;
1 S U4=R I U4="-" G END
 I U4="C" D CLN G 1
 I U4="R" D REC G 1
 I U4="S" D SND G 1
 I U4="T" D STO G 1
 I U4="H" D RESEND G 1
 I U4="V" D VRW G 1
 I U4'="?",U4'="HELP" S R=VTB G 1
 D HLP I "\-\?\HELP\R\S"[(D_R_D),R'=VTB G 1
 S R=VTB,VTB="" G 1
 ;
END K ^HULP($J) Q
 ;
Z X ^cZ Q
ZZ ; 16.09.91 - 16 u 47