Program Antrian Rumah Sakit (pascal stack)

Kudena.blogspot.com-Rabu(2/4) , Hallo sahabat Kudena,kali ini kita akan mengeshare Program Antrian Rumah sakit dengan Menggunakan Sistem Stack , Mungkin ini rumit namun jika terlaten saya yakin anda bisa , langsung saja copas :

program antrian_rs;
uses crt;
const max=10;
type antrian=record
    nomor:array[1..max] of byte;
    depan,belakang:0..max;
    end;
var rs:antrian;
    nomer:0..25;
    i,pil:byte;
   
function penuh(x:antrian):boolean;
begin if x.belakang=max then penuh:=true else penuh:=false;end;
   
function kosong(x:antrian):boolean;
begin if x.belakang=0 then kosong:=true else kosong:=false;end;

procedure masuk_antrian(var x:antrian);
begin
    Writeln('selamat datang di antrian rs sehat selalu');
    inc(nomer);
    inc(x.belakang);x.nomor[x.belakang]:=nomer;
    Writeln('anda mendapat nomor antrian ',nomer);
    Writeln('saat ini sedang mengantri ',x.belakang,' orang');
    Writeln('mohon bersabar');
end;

procedure layanan(var x:antrian);
begin
    Writeln('yang mendapat layanan berikutnya adalah nomor antrian ',x.nomor[x.depan]);
    {gese}
    for i:=x.depan to x.belakang do x.nomor[i]:=x.nomor[i+1];
    dec(x.belakang);
    Writeln('antrian tersisisa ',x.belakang,' orang');
end;

procedure cetak_antrian(var x:antrian);
begin
    Writeln('berikut antrian yang ada saat ini ');writeln;
    Writeln('posisis   nomor antrian');
    Writeln('-----------------------');
    for i:=x.depan to x.belakang do
        Writeln(i:4,'   ',' nomer ',x.nomor[i]:3);
    Writeln('-----------------------');
    Writeln('jumlah antrian : ',x.belakang,' orang' );
end;

procedure sisip_antrian(var x:antrian);
var pos:byte;ada:boolean;
label ulang;
begin
    Writeln('selamat datang di antrian');
    inc(nomer);
    Writeln('anda mendapat nomor antrian ',nomer);
    ulang:
    Write('akan disispkan di antrian nomor berapa ? ');Readln(pos);
    if (pos<x.depan) or (pos>x.belakang+1) then begin Writeln('posisi tidak valid');goto ulang; end else
        begin
            if pos=x.belakang+1 then
            begin
                inc(x.belakang); x.nomor[x.belakang]:=nomer;
            end
            else
            begin
                inc(x.belakang);
                {geser}
                for i:=x.belakang downto pos+1 do x.nomor[i]:=x.nomor[i-1];
                x.nomor[pos]:=nomer;
            end;
        end;
    Writeln('antrian saat ini ',x.belakang,' orang');
end;

procedure keluar_antrian(var x:antrian);
var nk,pos:byte; ada:boolean; ya:char;
begin
    Writeln('keluar dari antrian');
    Write('masukan nomor yang akan keluar :');Readln(nk);
    ada:=false;
    for i:=x.depan to x.belakang do if x.nomor[i]=nk then begin ada:=true;pos:=i;end;
   
    if ada then
    begin
        Write('yakin akan keluar dari antrian ? ');Readln(ya);
        if (ya='Y') or (ya='y') then
        begin
            Writeln('nomor antrian ',nk,' keluar dari antrian');
            for i:=pos to x.belakang do x.nomor[i]:=x.nomor[i+1];
            dec(x.belakang);
        end else
        Writeln('artian nomor ',nk,' batal keluar dar antrian');
    end else
    Writeln('nomor antrian tidak ditemukan');
    Writeln('antrian saat ini ada ',x.belakang,' orang');
end;

begin
rs.depan:=1;rs.belakang:=0;nomer:=0;
repeat
    clrscr;
    Writeln('pelayanan antrian di rs');writeln;
    Writeln('1. masuk antrian');
    Writeln('2. mendapat layanan');
    Writeln('3. cetak antrian');
    Writeln('4. pasien emergency');
    Writeln('5. keluar antrian');
    Write('pilih layanan => ');Readln(pil);
    case pil of
    1: if nomer>=25 then Writeln('nomor antrian sudah habis, silahkan langsung ke icu') else
        if penuh(rs) then Writeln('mohon maaf ruangan sudah penuh, tunggu sebentar lagi') else
        masuk_antrian(rs);
    2: if kosong(rs) then Writeln('tidak ada pasien yang harus dilayani') else layanan(rs);
    3: if kosong(rs) then Writeln('antrian sedang kosong') else cetak_antrian(rs);
    4: if nomer>=25 then Writeln('nomor antrian habis, silahkan langsung ke icu') else
        if penuh(rs) then Writeln(' mohon tunggu sebentar') else sisip_antrian(rs);
    5: if kosong(rs) then Writeln('antrian sudah kosong') else keluar_antrian(rs);
    0: Writeln('terima kasih');
    else Writeln('anda salah memilih menu');
    end;
    readln;
    until pil=0;
end.

Berikut Keluarannya :

Yang Perlu anda ketahui tentang "APRIL MOP"

Kudena.blogspot.com-Rabu(1/4) , hallo hallo sahabat kudena,lagi jadi tranding topik nih tentang APRIL MOP , Sebenarnya apa sih itu april mop ? April Mop itu dikenal dengan April Fools' Day dalam bahasa Inggris, diperingati setiap tanggal 1 April setiap tahun. Pada hari itu, orang dianggap boleh berbohong atau memberi lelucon kepada orang lain tanpa dianggap bersalah. Hari ini ditandai dengan tipu-menipu dan lelucon lainnya terhadap keluarga, musuh, teman bahkan tetangga dengan tujuan mempermalukan orang-orang yang mudah ditipu. Di beberapa negara seperti Inggris dan Australia serta Afrika Selatan, lelucon hanya boleh dilakukan sampai siang atau sebelum siang hari.[1] Seseorang yang memainkan trik setelah tengah hari disebut sebagai "April Mop".[2] Namun di tempat lain seperti Kanada, Perancis, Irlandia, Italia, Rusia, Belanda, dan Amerika Serikat lelucon bebas dimainkan sepanjang hari. Hari itu juga banyak diperingati di Internet.

Bahasa pemograman PHP pun merayakan April Mop ini dengan mengganti logo php pada setiap page 'php info'. Perhatikan logo PHP pada php info, setiap tanggal 1 April, logo tersebut akan berubah menjadi gambar-gambar lain yang lucu, misalnya gambar anjing, gambar drakula, dan gambar Batman.

PERLU ANDA KETAHUI,Rutinitas lelucon April Mop sering membuat orang-orang yang memperingatinya sering meragukan liputan berita yang terbit pada tanggal 1 April.

• Tsunami April Mop di Hilo, Hawaii.Pada 1 April 1946, gempa bumi disertai tsunami membunuh 165 orang di Hawaii dan Alaska mengakibatkan dibuatnya sistem peringatan tsunami. Di Hawaii, tsunami ini dikenal dengan "Tsunami April Mop", karena banyaknya orang yang mati karena tidak percaya berita akan kedatangan tsunami tersebut.
• Kematian Raja George II dari Yunani pada tanggal 1 April 1947.
• AMC Gremlin yang pertama kali diperkenalkan pada tanggal 1 April 1970.[3]
• Pada tahun 1979, Iran menyatakan bahwa 1 April merupakan Hari Republik. Kabar ini dianggap sebagai lelucon hingga tiga puluh tahun kemudian.[4]
• Pada tanggal 1 April 1984, penyanyi Marvin Gaye ditembak dan dibunuh oleh ayahnya. Awalnya, orang beranggapan bahwa itu adalah berita palsu, terutama mengingat aspek aneh ayah menjadi seorang pembunuh.
• Pada 1 April 1993, juara NASCAR Seri Piala Winston, Alan Kulwicki tewas dalam kecelakaan pesawat yang melibatkan eksekutif Hooters dari Amerika di Blountville, Tennessee dekat Bandara Tri-Cities. Perjalanan itu menuju ke Food City 500 yang dijadwalkan untuk hari berikutnya.
• Deathrock legenda Rozz Williams wafat karena bunuh diri pada tanggal 1 April 1998.
• Pada tanggal 1 April 1999 wilayah barat laut Kanada terpecah yang sekarang wilayah itu bernama Nunavut.
• Persaingan antara Merger Square dan perusahaan saingannya, Enix, terjadi pada 1 April 2003, dan pada awalnya dianggap sebagai lelucon.
• Leslie Cheung, penyanyi dan aktor terkenal asal Hong Kong, bunuh diri pada tahun 2003 karena depresi berat.
• Peluncuran Gmail pada April 2004 oleh Google juga awalnya dianggap lelucon, karena Google memang terkenal sering memasang lelucon April Mop pada situs mereka

waduh-waduh jangan-jangan lo nembak cewe hari ini bakalan dikira april mop,hahaha.. lantas bagaimana dengan pandangan menurut ISLAM ?
Perayaan ini adalah hal yang diharamkan dalam islam. dari segi filosofinya,april mop adalah budaya kufur yang dimana muslimin Haram mengikuti budaya tersebut. dalam sebuah hadits Rasulullah SAW bersabda

مَنْ تَشَبَّهَ بِقَوْمٍ فَهُوَ مِنْهُمْ

Siapa saja yang menyerupai suatu kaum,maka ia tergolong bagian dari kaum tersebut ( HR. AHmad,Abu Daud & Thabariy) 

Al-Munaawiy rahimahullah berkata:

وَقِيْلَ الْمَعْنَى: مَنْ تَشَبَّهَ بِالصَّالِحِيْنَ وَهُوَ مِنْ أَتْبَاعِهِمْ يُكْرَمُ كَمَا يُكْرَمُوْنَ، وَمَنْ تَشَبَّهَ بِالْفُسَاقِ يُهَانُ وَيُخْذَلُ كَهُمْ، وَمَنْ وَضَعَ عَلَيْهِ عَلاَمَةَ الشَّرْفِ أَكْرَمُ وَإِنْ لَمْ يَتَحَّقَّقْ شَرْفُهُ

“Dikatakan maknanya adalah : barangsiapa yang menyerupai orang-orang shaalih, maka ia termasuk orang yang mengikuti mereka. Ia pun dimuliakan sebagaimana orang-orang shaalih itu dimuliakan. Barangsiapa yang menyerupai orang-orang fasiq, maka akan dihinakan dan direndahkan sebagaimana mereka (dimuliakan dan direndahkan). Dan barangsiapa yang diletakkan padanya tanda-tanda kehormatan, ia lebih mulia meskipun kehormatannya itu tidak kelihatan.”

Lagian juga budaya ini mengajarkan untuk berbohong dan usil,jelas sekali ini sangat dilarang oleh agama. iiah lo yang diusilin suka,lo gak? bisa memutuskan silaturahmi tuh,jadi teman2ku yang baik hatinya (asikk) , Untuk selanjutnya itu terserah anda,saya disini hanya memberi tau saja.. 

Program Bobot Nilai (Pascal)

Kudena.blogspot.com-Senen(30/3) , hay anak-anak kuliah yang sedang galau dengan program pascal,ini nih ada contoh tugas pascal larik dalam record Program Nilai Mahasiswa,penasaran ? langsung copas dan perlajari saja kode dibawah ini :

program program_mhs;
uses crt;

const max=10;

type mhsku=record
nim,nama:string;
mk:array[1..max] of string;
sks:array[1..max] of byte;
nilai:array[1..max] of char;
ip:real;
end;
larik=array[1..max] of mhsku;

var mhs:larik;
i,j,m,jumsks,pil:byte;
n:array[1..max] of byte;

function bobot(y:char):byte;
begin
case y of
'A':bobot:=4;'a':bobot:=4;
'B':bobot:=3;'b':bobot:=3;
'C':bobot:=2;'c':bobot:=2;
'D':bobot:=1;'d':bobot:=1;
'E':bobot:=0;'e':bobot:=0;
'0':bobot:=0; end;
end;

procedure isi_data(var x:larik);
var mutu:real; ni,ya:char;
begin
repeat
clrscr;
jumsks:=0;mutu:=0;
writeln('isi identitas mahasiswa');
inc(m);
write('masukkan nim     :   > ');readln(x[m].nim);
write('masukan nama     :  > ');readln(x[m].nama);
write('banyaknya matkul : > ');readln(n[m]);writeln;
for i:=1 to n[m] do
begin
write('mata kuliah ke ',i,' : ');readln(x[m].mk[i]);
write('sks    : ');readln(x[m].sks[i]);
write('nilai  : ');readln(ni);
if (ni<>'A')and(ni<>'a')and(ni<>'B')and(ni<>'b')and
(ni<>'C')and(ni<>'c')and(ni<>'D')and(ni<>'d')and
(ni<>'E')and(ni<>'e') then begin writeln('salah');readln;exit;end else
x[m].nilai[i]:=ni;
jumsks:=jumsks+x[m].sks[i];
mutu:=mutu+ (bobot(x[m].nilai[i])*x[m].sks[i]);
writeln;
end;
x[m].ip:=mutu/jumsks;
write('isi lagi ? > ');readln(ya);
until (ya<>'y') or (m>=max);
end;

procedure cetak_semua(x:larik);
begin
clrscr;
writeln('cetak semua');writeln;
for i:=1 to m do
begin
writeln('data mahasiswa ke ',i);
jumsks:=0;
writeln('nim  = ',x[i].nim);
writeln('nama = ',x[i].nama);writeln;
writeln('-------------------------------------------------');
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
writeln('-------------------------------------------------');
for j:=1 to n[i] do
writeln(j:2,x[i].mk[j]:20,x[i].sks[j]:6,x[i].nilai[j]:6,bobot(x[i].nilai[j])*x[i].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[i].ip:0:2);
writeln;writeln('----------------------------------------');
end;
readln;
end;

procedure cetak_nomor(x:larik);
var no:byte;
begin
clrscr;
jumsks:=0;
writeln('cetak nomor');writeln;
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:20,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[no].ip:0:2);
end;
readln;
end;

procedure cetak_nim(x:larik);
var nims:string;pos:byte;ada:boolean;
begin
clrscr;
jumsks:=0;ada:=false;
writeln('cetak nim');writeln;
write('nim > ');readln(nims);
for i:=1 to m do if x[i].nim=nims then begin ada:=true;pos:=i; end;
if not ada then writeln('nim ',nims,' tidak ditemukan') else
begin
writeln('nim  = ',x[pos].nim);
writeln('nama = ',x[pos].nama);writeln;
writeln('no':2,'mata kuliah':20,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[pos] do
writeln(j:2,x[pos].mk[j]:20,x[pos].sks[j]:6,x[pos].nilai[j]:6,bobot(x[pos].nilai[j])*x[pos].sks[j]:6);
writeln;writeln('jumlah sks = ',jumsks);
writeln('ipk        = ',mhs[pos].ip:0:2);
end;
readln;
end;

procedure cetak_data(var x:larik);
var pil1:byte;
begin
repeat
clrscr;
writeln('cetak data');
writeln(' 1. cetak semua');
writeln(' 2. cetak berdasar nomor record');
writeln(' 3. cetak berdasar nim');
writeln(' 4. kembali');
write('pilih > ');readln(pil1);
case pil1 of
1: cetak_semua(x);
2: cetak_nomor(x);
3: cetak_nim(x);
4: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil1=4;
readln;
end;

procedure tampilkan(x:larik);
begin
writeln('no':2,'nim':12,'nama':18);
for i:=1 to m do writeln(i:2,x[i].nim:12,x[i].nama:18);
end;

procedure edit_identitas(var x:larik);
var no,pil2:byte;
begin
clrscr;
writeln('edit identitas');
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('1. nim  =',x[no].nim);
writeln('2. nama =',x[no].nama);
writeln('3. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('nim baru  > ');readln(x[no].nim); end;
2: begin write('nama baru > ');readln(x[no].nama); end;
3: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=3;
end;
end;

procedure edit_mk(var x:larik);
var no,no2,pil2:byte;
begin
clrscr;
writeln('edit mata kuliah');
write('masukkan nomor record : ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do
writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk : ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
repeat
clrscr;
writeln('1. matkul  = ',x[no].mk[no2]);
writeln('2. sks     = ',x[no].sks[no2]);
writeln('3. nilai   = ',x[no].nilai[no2]);
writeln('4. selesai');
write('pilih > ');readln(pil2);
case pil2 of
1: begin write('matkul baru : ');readln(x[no].mk[no2]); end;
2: begin write('sks baru    : ');readln(x[no].sks[no2]); end;
3: begin write('nilai baru  : ');readln(x[no].nilai[no2]); end;
4: writeln('edit selesai');
else writeln('tidak sesuai');
end;
readln;
until pil2=4;
end;
readln;
until no2=j+1;
end;
end;

procedure edit_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. edit identitas');
writeln(' 2. edit mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else edit_identitas(x);
2: if m=0 then writeln('belum ada data.') else edit_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

procedure hapus_mahasiswa(var x:larik);
var no:byte;ya2:char;
begin
clrscr;
jumsks:=0;
writeln('hapus mahasiswa');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
writeln('nim  =',x[no].nim);
writeln('nama =',x[no].nama);
write('yakin ingin menghapus : ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no to m-1 do x[i]:=x[i+1];
x[m].nim:='';
x[m].nama:='';
for j:=1 to n[m] do
begin
x[m].mk[j]:='';
x[m].sks[j]:=0;
x[m].nilai[j]:='0';
end;
dec(m);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
end;

procedure hapus_mk(var x:larik);
var no,no2:byte;ya2:char;
begin
clrscr;
writeln('hapus mata kuliah');
tampilkan(x);
write('nomor record > ');readln(no);
if (no<1) or (no>m) then writeln('record tidak tersedia') else
begin
repeat
clrscr;
writeln('nim  = ',x[no].nim);
writeln('nama = ',x[no].nama);
writeln('no':2,'mata kuliah':16,'sks':6,'nilai':6,'mutu':6);
for j:=1 to n[no] do writeln(j:2,x[no].mk[j]:16,x[no].sks[j]:6,x[no].nilai[j]:6,bobot(x[no].nilai[j])*x[no].sks[j]:6);
writeln(j+1:2,' selesai');
write('nomor mk > ');readln(no2);
if (no2<1) or (no2>n[no]+1) then writeln('record tidak tersedia') else
if (no2=n[no]+1) then writeln('selesai') else
begin
writeln('matkul  =',x[no].mk[no2]);
writeln('sks     =',x[no].sks[no2]);
writeln('nilai   =',x[no].nilai[no2]);
write('yakin ? > ');readln(ya2);
if (ya2='Y')or(ya2='y') then
begin
for i:=no2 to n[no2]-1 do begin x[no].mk[i]:=x[no].mk[i+1];x[no].sks[i]:=x[no].sks[i+1];x[no].nilai[i]:=x[no].nilai[i+1]; end;
x[m].mk[n[no2]]:='';
x[m].sks[n[no2]]:=0;
x[m].nilai[n[no2]]:='0';
dec(n[no2]);
writeln('penghapusan selesai');
end
else writeln('tidak sesuai');
readln;
end;
readln;
until no2=j+1;
end;
readln;
end;

procedure hapus_data(var x:larik);
var pil2:byte;
begin
repeat
clrscr;
writeln('edit data');
writeln(' 1. hapus mahasiswa');
writeln(' 2. hapus mata kuliah');
writeln(' 3. kembali');
write('pilih > ');readln(pil2);
case pil2 of
1: if m=0 then writeln('belum ada data.') else hapus_mahasiswa(x);
2: if m=0 then writeln('belum ada data.') else hapus_mk(x);
3: writeln('tekan enter untuk kembali');
else writeln('tidak tersedia');
end;
until pil2=3;
readln;
end;

begin
repeat
clrscr;
writeln('pengolahan data mahasiswa');
writeln(' 1. isi data');
writeln(' 2. cetak data');
writeln(' 3. edit data');
writeln(' 4. hapus data');
writeln(' 5. keluar');
write('pilih > ');readln(pil);
case pil of
1: if m>=max then writeln('sudah penuh.') else isi_data(mhs);
2: if m=0 then writeln('belum ada data.') else cetak_data(mhs);
3: if m=0 then writeln('belum ada data.') else edit_data(mhs);
4: if m=0 then writeln('belum ada data.') else hapus_data(mhs);
5: writeln('sampai jumpa.');
else writeln('pilihan salah.');
end;
readln;
until pil=5;
readln;
end.