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 :