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