begin
externalroutinespec prompt(String (255) s)
externalroutinespec ucstrg(stringname s)
externalroutinespec rdint(integername i)
routine kdate(integer name d, m, y, integer k)
! K IS DAYS SINCE 1ST JAN 1900
! RETURNS D, M, Y 2 DIGIT Y ONLY
! %integer W
! K=K+693902; ! days since Cleopatras birthday
! W=4*K-1
! Y=W//146097
! K=W-146097*Y
! D=K//4
! K=(4*D+3)//1461
! D=4*D+3-1461*K
! D=(D+4)//4
! M=(5*D-3)//153
! D=5*D-3-153*M
! D=(D+5)//5
! Y=K
*lss_k; *iad_693902
*imy_4; *isb_1; *imdv_146097
*lss_ tos ; *idv_4; *imy_4; *iad_3
*imdv_1461; *st_(y)
*lss_ tos ; *iad_4; *idv_4
*imy_5; *isb_3; *imdv_153
*st_(m); *lss_ tos
*iad_5; *idv_5; *st_(d)
if m<10 then m=m+3 else start
m=m-9
if y=99 then y=0 else y=y+1
finish
end ; ! OF KDATE
integer i, d, m, y
string (255) wk
prompt("Date->dayno or dayNo->date (D/N) ? ")
ucstrg(wk) until wk="D" or wk="N"
if wk="N" start
prompt("Daynumber: ")
rdint(i)
kdate(d, m, y, i)
write(d, 1); write(m, 1); write(y, 1)
newline
finish
endofprogram