Advertisement
juliozaco

dia de la semana con mumps

May 19th, 2011
135
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. DIAFECHA(FE)    ;
  2.     N (FE)
  3.     Q:FE=""
  4.     ; algoritmo de Gauss
  5.     S ANO=$E(FE,1,4) S MES=+$E(FE,5,6) S DIA=+$E(FE,7,8)
  6.     S DOSANO=+$E(ANO,3,4),CC=+$E(ANO,1,2)
  7.     ;
  8.     I FE>15821014 S MOD=CC#4 S A=$S(MOD=1:5,MOD=2:3,MOD=3:1,MOD=0:0)
  9.     ; I FE>17000000 S A=$S(ANO>2199:-4,ANO>2099:-2,ANO>1999:0,ANO>1899:1,ANO>1799:3,ANO>1699:5,1:0)
  10.     I FE<15821015 S A=19-CC
  11.     ; rizando el rizo para en españa dias anteriores al 4 de oct pasó al 15 de oct de 1582
  12.     ; para los ingleses dle 3 sept de 1752 al 14 de sept de 1752
  13.     ;
  14.     S CUARTO=DOSANO\4 S B=DOSANO+CUARTO
  15.     ; bisiesto
  16.     S C=0
  17.     I ANO#4=0 I DOSANO'=0 S I (MES=1)!(MES=2) S C=-1
  18.     I ANO#4=0 I DOSANO=0 I ANO#400=0 I (MES=1)!(MES=2) S C=-1
  19.     ;
  20.     S D=$S(MES=1:6,MES=2:2,MES=3:2,MES=4:5,MES=5:0,MES=6:3,MES=7:5,MES=8:1,MES=9:4,MES=10:6,MES=11:2,MES=12:4)
  21.     ;
  22.     S E=DIA
  23.     ;
  24.     S SUMA=A+B+C+D+E
  25.     S R=SUMA#7
  26.     S RESUL=$S(R=1:"LUNES",R=2:"MARTES",R=3:"MIERCOLES",R=4:"JUEVES",R=5:"VIERNES",R=6:"SABADO",R=0:"DOMINGO")
  27.     Q RESUL
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement