Encore une histoire de date "legacy"...
Un pgm de service, deux fonctions,
et le pgm de test.
******* Prototype PSDT01CP ****************************
D dt8u pr 8 0
D dt8ix 8 0 value
D dt8i pr 8 0
D dt8ux 8 0 value
******* Programme de Service PSDT01 *******************
Hnomain
D/copy sources,psdt010cp
* jmsa = dt8u(samj)
* donne une pseudo date utilisateur
* à partir d'une pseudo date informatique,
* pas de vérification
P dt8u b export
D pi 8 0
D dt8ix 8 0 value
D samj ds
D dt8i 8 0 overlay(samj)
D ssi 2 0 overlay(dt8i:*next)
D aai 2 0 overlay(dt8i:*next)
D mmi 2 0 overlay(dt8i:*next)
D jji 2 0 overlay(dt8i:*next)
D jmsa ds
D dt8u 8 0 overlay(jmsa)
D jju 2 0 overlay(dt8u:*next)
D mmu 2 0 overlay(dt8u:*next)
D ssu 2 0 overlay(dt8u:*next)
D aau 2 0 overlay(dt8u:*next)
/free
dt8i = dt8ix;
jju = jji;
mmu = mmi;
ssu = ssi; // Hum, ces 2 lignes pourraient être
aau = aai; // un peu plus... un peu moins....
// Expliquez pourquoi,vous avez 4 minutes...
return dt8u;
/end-free
P e
* samj = dt8i(jmsa)
* donne une pseudo date informatique
* à partir d'une pseudo date utilisateur,
* vérification : 0 si pas bon.
P dt8i b export
D pi 8 0
D dt8ux 8 0 value
D dt8i s 8 0
/free
monitor;
dt8i = %dec(%date(dt8ux:*eur):*iso);
on-error;
dt8i = 0;
endmon;
return dt8i;
/end-free
P e
**********************************************
* Teste un pgm de service
*
Hdftactgrp(*no)
Hoption(*srcstmt:*nodebugio)
Hbnddir('MILAN')
Fpsdt010td cf e workstn
D/copy sources,psdt010cp
D sdsw sds
D procw *proc
D jobnw 10 overlay(sdsw:244)
D usernw s 10 inz(*user)
D bouclew s n
/free
dou bouclew;
exfmt ecran01;
if *inkc or *inkl;
exsr srfin;
endif;
date1ww = dt8u(date1w);
date2ww = dt8i(date2w);
enddo;
//**SR********************
begsr srfin;
exfmt ecran02w;
*inlr = *on;
return;
endsr;
